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

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

Changeset 2977


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

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

Location:
branches/2011/dev_LOCEAN_2011/NEMOGCM
Files:
3 deleted
132 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r2715 r2977  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/OPA  :  1 - run manager      (namrun) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
     3!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    55!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf,  
    … …  
    5151!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5252!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    53 !!   namdta_tem   data: temperature                                     ("key_dtatem") 
    54 !!   namdta_sal   data: salinity                                        ("key_dtasal") 
     53!!   namtsd       data: temperature & salinity          
    5554!!====================================================================== 
    5655! 
    … …  
    9493/ 
    9594!----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     95&namtsd    !   data : Temperature  & Salinity                            
     96!----------------------------------------------------------------------- 
     97!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     98!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     99   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     100   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101101   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     102   cn_dir        = './'      !  root directory for the location of the runoff files 
     103   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     104   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     105/ 
    114106!!====================================================================== 
    115107!!            ***  Surface Boundary Condition namelists  *** 
    … …  
    442434!!   namtra_adv    advection scheme 
    443435!!   namtra_ldf    lateral diffusion scheme 
    444 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp") 
     436!!   namtra_dmp    T & S newtonian damping                         
    445437!!====================================================================== 
    446438! 
    … …  
    483475/ 
    484476!----------------------------------------------------------------------- 
    485 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp') 
    486 !----------------------------------------------------------------------- 
     477&namtra_dmp    !   tracer: T & S newtonian damping                       
     478!----------------------------------------------------------------------- 
     479   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F) 
    487480   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    488481                           !                   =XX, damping poleward of XX degrees (XX>0) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm

    r2670 r2977  
    1  bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_iomput 
     1 bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_lobster

    r2567 r2977  
    9898/ 
    9999!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    100 &namlobdia     !   additional 2D/3D tracers diagnostics ("key_trc_diaadd") 
     100&namlobdia     !   additional 2D/3D tracers diagnostics 
    101101!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    102    nn_writedia =  360  !  time step frequency for tracers diagnostics 
    103 ! 
    104102!              !    name   ! title of   ! units ! 
    105103!              !           ! the field  !       !   
    … …  
    130128&namlobdbi     !   biological diagnostics trends      
    131129!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    132 !                !  3D bio diagnostics   units : mmole/m3/s   ("key_trc_diabio") 
    133130!                !  2D bio diagnostics   units : mmole/m2/s   ("key_trdmld_trc") 
    134  
    135    nwritebio    =   4320    !  time step frequency for biological outputs 
    136 ! 
    137131!                !  name    !       title of the field      !     units      ! 
    138132   lobdiabio(1)  = 'NO3PHY' , 'Flux from NO3 to PHY          ',  'mmole/m3/s' 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_top

    r2528 r2977  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! NEMO/TOP1 :  1 - tracer definition                     (namtrc    ) 
    3 !! namelists    2 - dynamical tracer trends               (namtrc_trd) 
    4 !!              3 - tracer advection                      (namtrc_adv) 
    5 !!              4 - tracer lateral diffusion              (namtrc_ldf) 
    6 !!              5 - tracer vertical physics               (namtrc_zdf) 
    7 !!              6 - tracer newtonian damping              (namtrc_dmp) 
     2!! NEMO/TOP2 namelits :  1 - tracer definition                     (namtrc    ) 
     3!!                       2 - tracer advection                      (namtrc_adv) 
     4!!                       3 - tracer lateral diffusion              (namtrc_ldf) 
     5!!                       4 - tracer vertical physics               (namtrc_zdf) 
     6!!                       5 - tracer newtonian damping              (namtrc_dmp) 
     7!!                       6 - dynamical tracer trends               (namtrc_trd) 
     8!!                       7 - tracer output                         (namtrc_wri) 
    89!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    910!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    1011&namtrc     !   tracers definition 
    1112!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     13! 
    1214   nn_dttrc      =  1        !  time step frequency for passive sn_tracers 
    13    nn_writetrc   =  360      !  time step frequency for sn_tracer outputs 
     15   nn_writetrc   =  60      !  time step frequency for sn_tracer outputs 
    1416   ln_rsttr      = .false.   !  start from a restart file (T) or not (F) 
    15    nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value 
     17   nn_rsttr      =   1       !  restart control = 0 initial time step is not compared to the restart file value 
    1618                           !                  = 1 do not use the value in the restart file 
    1719                           !                  = 2 calendar parameters read in the restart file 
    18    cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
     20   cn_trcrst_in  = "restart_trc.nc"   !  suffix of pass. sn_tracer restart name (input) 
    1921   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     22   ln_trcdta     =   .false.    !  Initialisation from data input file (T) or not (F) 
    2023! 
    21 !              ! name  !     title of the field       !   units       ! initial data ! save   ! 
    22 !              !       !                              !               ! from file    ! or not !  
    23 !              !       !                              !               ! or not       !        ! 
    24    sn_tracer(1)   = 'DET' , 'Detritus                   ',  'mmole-N/m3' ,  .false.     ,  .true. 
    25    sn_tracer(2)   = 'ZOO' , 'Zooplankton concentration  ',  'mmole-N/m3' ,  .false.     ,  .true. 
    26    sn_tracer(3)   = 'PHY' , 'Phytoplankton concentration',  'mmole-N/m3' ,  .false.     ,  .true. 
    27    sn_tracer(4)   = 'NO3' , 'Nitrate concentration      ',  'mmole-N/m3' ,  .false.     ,  .true. 
    28    sn_tracer(5)   = 'NH4' , 'Ammonium concentration     ',  'mmole-N/m3' ,  .false.     ,  .true. 
    29    sn_tracer(6)   = 'DOM' , 'Dissolved organic matter   ',  'mmole-N/m3' ,  .false.     ,  .true. 
     24!                ! name  !     title of the field          !   units       ! initial data ! save   ! 
     25!                !       !                                 !               ! from file    ! or not !  
     26!                !       !                                 !               ! or not       !        ! 
     27   sn_tracer(1)   = 'DET'   , 'Detritus                   ',  'mmole-N/m3' ,  .false.     ,  .false. 
     28   sn_tracer(2)   = 'ZOO'   , 'Zooplankton concentration  ',  'mmole-N/m3' ,  .false.     ,  .false. 
     29   sn_tracer(3)   = 'PHY'   , 'Phytoplankton concentration',  'mmole-N/m3' ,  .false.     ,  .false. 
     30   sn_tracer(4)   = 'NO3'   , 'Nitrate concentration      ',  'mmole-N/m3' ,  .false.     ,  .true. 
     31   sn_tracer(5)   = 'NH4'   , 'Ammonium concentration     ',  'mmole-N/m3' ,  .false.     ,  .false. 
     32   sn_tracer(6)   = 'DOM'   , 'Dissolved organic matter   ',  'mmole-N/m3' ,  .false.     ,  .false. 
    3033/ 
    3134!----------------------------------------------------------------------- 
    32 &namtrc_adv    !   advection scheme for passive tracer 
     35&namtrc_dta      !    Initialisation from data input file (T) or not (F) 
    3336!----------------------------------------------------------------------- 
    34    ln_trcadv_cen2   =  .false.  !  2nd order centered scheme 
     37! 
     38!                !  file name  ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     39!                !             !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     40   sn_trcdta(4)  = 'NO3_R1'    ,        -12        ,  'NO3'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     41 
     42   cn_dir        =     './'    !  root directory for the location of the runoff files 
     43   rn_trfac(4)   =    1.0      !   -       -       -       -      - 
     44/ 
     45!----------------------------------------------------------------------- 
     46&namtrc_adv    !   advection scheme for passive tracer  
     47!----------------------------------------------------------------------- 
     48   ln_trcadv_cen2   =  .false.  !  2nd order centered scheme    
    3549   ln_trcadv_tvd    =  .true.   !  TVD scheme 
    3650   ln_trcadv_muscl  =  .false.  !  MUSCL scheme 
    … …  
    5165   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp") 
    5266!                               !  Coefficient 
     67   rn_ahtrc_0       =  1000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    5368   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s] 
    5469/ 
    … …  
    6075/ 
    6176!----------------------------------------------------------------------- 
    62 &namtrc_rad        !  treatment of negative concentrations 
     77&namtrc_rad        !  treatment of negative concentrations  
    6378!----------------------------------------------------------------------- 
    6479   ln_trcrad   =  .false.  !  artificially correct negative concentrations (T) or not (F) 
    6580/ 
    6681!----------------------------------------------------------------------- 
    67 &namtrc_dmp    !   passive tracer newtonian damping    ('key_tradmp && key_trcdmp') 
     82&namtrc_dmp    !   passive tracer newtonian damping   
    6883!----------------------------------------------------------------------- 
     84   ln_trcdmp   =  .false.  !  add a damping termn (T) or not (F) 
    6985   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    7086                           !                   =XX, damping poleward of XX degrees (XX>0) 
    … …  
    7995/ 
    8096!----------------------------------------------------------------------- 
    81 &namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc') 
    82 !                          or mixed-layer trends          ('key_trdmld_trc') 
     97&namtrc_trd                !   diagnostics on tracer trends        ('key_trdtrc') 
     98!                                   or mixed-layer trends          ('key_trdmld_trc') 
    8399!---------------------------------------------------------------------- 
    84    nn_trd_trc   =  360      !  time step frequency and tracers trends 
    85    nn_ctls_trc  =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk) 
    86    rn_ucf_trc   =  86400    !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
     100   nn_trd_trc  =  5475      !  time step frequency and tracers trends 
     101   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk) 
     102   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
    87103   ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics 
    88    ln_trdmld_trc_instant = .false.  !  flag to diagnose trends of instantantaneous or mean ML T/S 
     104   ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S 
    89105   ln_trdtrc(1)  =   .true. 
    90    ln_trdtrc(2)  =   .true. 
    91    ln_trdtrc(3)  =   .true. 
    92    ln_trdtrc(4)  =   .true. 
    93    ln_trdtrc(5)  =   .true. 
    94    ln_trdtrc(6)  =   .true. 
    95106/ 
     107!----------------------------------------------------------------------- 
     108&namtrc_dia       !   parameters for passive tracer additional diagnostics 
     109!---------------------------------------------------------------------- 
     110   ln_diatrc     =  .true.   !  save additional diag. (T) or not (F) 
     111   nn_writedia   =  60     !  time step frequency for diagnostics 
     112/ 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/GYRE_LOBSTER/cpp_GYRE_LOBSTER.fcm

    r2670 r2977  
    1 bld::tool::fppkeys  key_gyre key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_top key_lobster key_diatrc key_iomput  
     1bld::tool::fppkeys  key_gyre key_dynspg_flt key_ldfslp key_zdftke key_top key_lobster key_iomput  

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r2715 r2977  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/OPA  :  1 - run manager      (namrun) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
     3!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    55!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf,  
    … …  
    5151!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5252!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    53 !!   namdta_tem   data: temperature                                     ("key_dtatem") 
    54 !!   namdta_sal   data: salinity                                        ("key_dtasal") 
     53!!   namtsd       data: temperature & salinity                          
    5554!!====================================================================== 
    5655! 
    … …  
    9493/ 
    9594!----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     95&namtsd    !   data : Temperature  & Salinity                            
     96!----------------------------------------------------------------------- 
     97!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     98!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     99   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     100   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101101   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     102   cn_dir        = './'     !  root directory for the location of the runoff files 
     103   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     104   ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     105/ 
    114106!!====================================================================== 
    115107!!            ***  Surface Boundary Condition namelists  *** 
    … …  
    442434!!   namtra_adv    advection scheme 
    443435!!   namtra_ldf    lateral diffusion scheme 
    444 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp") 
     436!!   namtra_dmp    T & S newtonian damping                         
    445437!!====================================================================== 
    446438! 
    … …  
    483475/ 
    484476!----------------------------------------------------------------------- 
    485 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp') 
    486 !----------------------------------------------------------------------- 
     477&namtra_dmp    !   tracer: T & S newtonian damping                   
     478!----------------------------------------------------------------------- 
     479   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F) 
    487480   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    488481                           !                   =XX, damping poleward of XX degrees (XX>0) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm

    r2670 r2977  
    1  bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_zdftmx key_iomput  
     1 bld::tool::fppkeys key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput  

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces

    r2567 r2977  
    1515&nampisext     !   air-sea exchange 
    1616!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    17    atcco2     = 287.    ! atmospheric pCO2 
     17   ln_co2int  =  .false. ! read atm pco2 from a file (T) or constant (F) 
     18   atcco2     =  287.    ! Constant value atmospheric pCO2 - ln_co2int = F 
     19   clname     =  'atcco2.txt'  ! Name of atm pCO2 file - ln_co2int = T 
     20   nn_offset  =  0       ! Offset model-data start year - ln_co2int = T 
     21!                        ! If your model year is iyy, nn_offset=(years(1)-iyy)  
     22!                        ! then the first atmospheric CO2 record read is at years(1) 
     23/ 
     24!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     25&nampisatm     !  Atmospheric prrssure  
     26!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     27!              !  file name   ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     28!              !              !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     29   sn_patm     = 'presatm'    ,     -1            , 'patm'     ,  .true.      , .true. ,   'yearly'  , ''       , '' 
     30   cn_dir      = './'      !  root directory for the location of the dynamical files 
    1831/ 
    1932!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    2033&nampisbio     !   biological parameters 
    2134!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    22    part       =  0.85    ! part of calcite not dissolved in guts 
    2335   nrdttrc    =  1       ! time step frequency for biology 
    2436   wsbio      =  2.      ! POC sinking speed 
    2537   xkmort     =  1.E-7   ! half saturation constant for mortality 
    26    ferat3     =  3.E-6   ! Fe/C in zooplankton  
     38   ferat3     =  10.E-6  ! Fe/C in zooplankton  
    2739   wsbio2     =  30.     ! Big particles sinking speed 
    2840/ 
    … …  
    3143!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    3244   conc0      =  2.e-6    ! Phosphate half saturation 
    33    conc1      =  10E-6    ! Phosphate half saturation for diatoms 
    34    conc2      =  0.01E-9  ! Iron half saturation for phyto 
    35    conc2m     =  0.08E-9  ! Max iron half saturation for phyto 
    36    conc3      =  0.1E-9   ! Iron half saturation for diatoms 
    37    conc3m     =  0.4E-9   ! Maxi iron half saturation for diatoms 
     45   conc1      =  8E-6     ! Phosphate half saturation for diatoms 
     46   conc2      =  1E-9     ! Iron half saturation for phyto 
     47   conc2m     =  3E-9     ! Max iron half saturation for phyto 
     48   conc3      =  2E-9     ! Iron half saturation for diatoms 
     49   conc3m     =  8E-9     ! Maxi iron half saturation for diatoms 
     50   xsizedia   =  5.E-7    ! Minimum size criteria for diatoms 
     51   xsizephy   =  1.E-6    ! Minimum size criteria for phyto 
    3852   concnnh4   =  1.E-7    ! NH4 half saturation for phyto 
    39    concdnh4   =  5.E-7    ! NH4 half saturation for diatoms 
     53   concdnh4   =  4.E-7    ! NH4 half saturation for diatoms 
    4054   xksi1      =  2.E-6    ! half saturation constant for Si uptake 
    4155   xksi2      =  3.33E-6  ! half saturation constant for Si/C 
    4256   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization 
    43    caco3r     =  0.15     ! mean rain ratio 
     57   concfebac  =  3.E-11   ! Half-saturation for Fe limitation of Bacteria 
     58   qnfelim    =  7.E-6    ! Optimal quota of phyto 
     59   qdfelim    =  7.E-6    ! Optimal quota of diatoms 
     60   caco3r     =  0.16     ! mean rain ratio 
    4461/ 
    4562!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    4663&nampisprod     !   parameters for phytoplankton growth 
    4764!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    48    pislope    =  3.       ! P-I slope   
    49    pislope2   =  3.       ! P-I slope  for diatoms 
     65   pislope    =  2.       ! P-I slope 
     66   pislope2   =  2.       ! P-I slope  for diatoms 
    5067   excret     =  0.05     ! excretion ratio of phytoplankton 
    5168   excret2    =  0.05     ! excretion ratio of diatoms 
     69   ln_newprod =  .FALSE.  ! Enable new parame. of production (T/F)  
     70   bresp      =  0.00333  ! Basal respiration rate 
    5271   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton 
    53    chlcdm     =  0.05     ! Minimum Chl/C in diatoms 
    54    fecnm      =  10E-6    ! Maximum Fe/C in nanophytoplankton 
    55    fecdm      =  15E-6    ! Minimum Fe/C in diatoms 
     72   chlcdm     =  0.04     ! Minimum Chl/C in diatoms 
     73   chlcmin    =  0.0033   ! Maximum Chl/c in phytoplankton 
     74   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton 
     75   fecdm      =  40E-6    ! Minimum Fe/C in diatoms 
    5676   grosip     =  0.151    ! mean Si/C ratio 
    5777/ 
    … …  
    6888&nampismes     !   parameters for mesozooplankton 
    6989!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    70    grazrat2   =  0.7      ! maximal mesozoo grazing rate 
     90   part2      =  0.75    ! part of calcite not dissolved in mesozoo guts 
     91   grazrat2   =  0.9      ! maximal mesozoo grazing rate 
    7192   resrat2    =  0.005    ! exsudation rate of mesozooplankton 
    72    mzrat2     =  0.03     ! mesozooplankton mortality rate 
     93   mzrat2     =  0.04     ! mesozooplankton mortality rate 
    7394   xprefc     =  1.       ! zoo preference for phyto 
    74    xprefp     =  0.2      ! zoo preference for POC 
     95   xprefp     =  0.3      ! zoo preference for POC 
    7596   xprefz     =  1.       ! zoo preference for zoo 
    76    xprefpoc   =  0.2      ! zoo preference for poc 
     97   xprefpoc   =  0.3      ! zoo preference for poc 
     98   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton  
     99   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton  
     100   xthresh2phy = 2E-7     ! nanophyto feeding threshold for mesozooplankton  
     101   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton  
     102   xthresh2   =  0.       ! Food threshold for grazing 
    77103   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing 
    78    epsher2    =  0.33     ! Efficicency of Mesozoo growth  
     104   epsher2    =  0.3      ! Efficicency of Mesozoo growth 
    79105   sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM 
    80106   unass2     =  0.3      ! non assimilated fraction of P by mesozoo 
    81    grazflux   =  5.e3     ! flux-feeding rate 
     107   grazflux   =  3.e3     ! flux-feeding rate 
    82108/ 
    83109!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    84110&nampiszoo     !   parameters for microzooplankton 
    85111!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    86    grazrat    =  4.0      ! maximal zoo grazing rate    
     112   part       =  0.5      ! part of calcite not dissolved in microzoo gutsa 
     113   grazrat    =  3.0      ! maximal zoo grazing rate 
    87114   resrat     =  0.03     ! exsudation rate of zooplankton 
    88115   mzrat      =  0.0      ! zooplankton mortality rate 
    89    xpref2c    =  0.1      ! Microzoo preference for POM  
    90    xpref2p    =  0.45     ! Microzoo preference for Nanophyto 
    91    xpref2d    =  0.45     ! Microzoo preference for Diatoms 
    92    xkgraz     =  20.E-6   ! half sturation constant for grazing  
    93    epsher     =  0.33     ! Efficiency of microzoo growth 
     116   xpref2c    =  0.2      ! Microzoo preference for POM 
     117   xpref2p    =  1.       ! Microzoo preference for Nanophyto 
     118   xpref2d    =  0.6      ! Microzoo preference for Diatoms 
     119   xthreshdia =  1.E-8    ! Diatoms feeding threshold for microzooplankton  
     120   xthreshphy =  2.E-7    ! Nanophyto feeding threshold for microzooplankton  
     121   xthreshpoc =  1.E-8    ! POC feeding threshold for microzooplankton  
     122   xthresh    =  0.       ! Food threshold for feeding 
     123   xkgraz     =  20.E-6   ! half sturation constant for grazing 
     124   epsher     =  0.3      ! Efficiency of microzoo growth 
    94125   sigma1     =  0.6      ! Fraction of microzoo excretion as DOM 
    95126   unass      =  0.3      ! non assimilated fraction of phyto by zoo 
    … …  
    98129&nampisrem     !   parameters for remineralization 
    99130!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    100    xremik    =  0.3       ! remineralization rate of DOC 
     131   xremik    =  0.25      ! remineralization rate of DOC 
    101132   xremip    =  0.025     ! remineralisation rate of POC 
    102133   nitrif    =  0.05      ! NH4 nitrification rate 
    103    xsirem    =  0.015     ! remineralization rate of Si 
     134   xsirem    =  0.003     ! remineralization rate of Si 
     135   xsiremlab =  0.025     ! fast remineralization rate of Si 
     136   xsilab    =  0.31      ! Fraction of labile biogenic silica 
    104137   xlam1     =  0.005     ! scavenging rate of Iron 
    105    oxymin    =  1.E-6     ! Half-saturation constant for anoxia  
     138   oxymin    =  1.E-6     ! Half-saturation constant for anoxia 
     139   ligand    =  0.6E-9    ! Ligands concentration 
    106140/ 
    107141!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    108142&nampiscal     !   parameters for Calcite chemistry 
    109143!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    110    kdca       =  0.327e3  ! calcite dissolution rate constant (1/time) 
     144   kdca       =  6.       ! calcite dissolution rate constant (1/time) 
    111145   nca        =  1.       ! order of dissolution reaction (dimensionless) 
    112146/ 
    … …  
    114148&nampissed     !   parameters for inputs deposition 
    115149!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    116    ln_dustfer  =  .true.   ! boolean for dust input from the atmosphere 
    117    ln_river    =  .true.  ! boolean for river input of nutrients 
     150!              !  file name        ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     151!              !                   !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     152   sn_dust     = 'dust.orca'       ,     -1            , 'dust'     ,  .true.      , .true. ,   'yearly'  , ''       , '' 
     153   sn_riverdic = 'river.orca'      ,    -12            , 'riverdic' ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     154   sn_riverdoc = 'river.orca'      ,    -12            , 'riverdoc' ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     155   sn_ndepo    = 'ndeposition.orca',    -12            , 'ndep'     ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     156   sn_ironsed  = 'bathy.orca'      ,    -12            , 'bathy'    ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     157! 
     158   cn_dir      = './'      !  root directory for the location of the dynamical files 
     159   ln_dust     =  .true.   ! boolean for dust input from the atmosphere 
     160   ln_river    =  .false.   ! boolean for river input of nutrients 
    118161   ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N 
    119    ln_sedinput =  .true.   ! boolean for Fe input from sediments 
     162   ln_ironsed =  .true.   ! boolean for Fe input from sediments 
    120163   sedfeinput  =  1E-9     ! Coastal release of Iron 
    121    dustsolub   =  0.014    ! Solubility of the dust 
     164   dustsolub   =  0.02     ! Solubility of the dust 
     165   wdust       =  2.0      ! Dust sinking speed 
     166   nitrfix     =  1E-7     ! Nitrogen fixation rate 
     167   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2) 
     168   concfediaz  =  1.E-10   ! Diazotrophs half-saturation Cste for Iron 
    122169/ 
    123170!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    … …  
    140187/ 
    141188!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    142 &nampisdia     !   additional 2D/3D tracers diagnostics ("key_trc_diaadd") 
    143 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    144    nn_writedia  =  5475   !  time step frequency for tracers diagnostics 
    145 ! 
     189&nampisdia     !   additional 2D/3D tracers diagnostics  
     190!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    146191!              !    name   !           title of the field          !     units      ! 
    147192!              !           !                                       !                !   
    … …  
    175220!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    176221   ln_pisdmp    =  .true.     !  Relaxation fo some tracers to a mean value 
    177 / 
     222   nn_pisdmp    =  5475       !  Frequency of Relaxation  
     223/ 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top

    r2528 r2977  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    ) 
    3 !! namelists    2 - dynamical tracer trends               (namtrc_trd) 
     3!!              2 - tracer data initialisation            (namtrc_dta) 
    44!!              3 - tracer advection                      (namtrc_adv) 
    55!!              4 - tracer lateral diffusion              (namtrc_ldf) 
    66!!              5 - tracer vertical physics               (namtrc_zdf) 
    77!!              6 - tracer newtonian damping              (namtrc_dmp) 
     8!!              7 - dynamical tracer trends               (namtrc_trd) 
     9!!              8 - tracer output diagonstics             (namtrc_dia) 
    810!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    911!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    … …  
    1820   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
    1921   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     22   ln_trcdta     =   .true. !  Initialisation from data input file (T) or not (F) 
    2023! 
    2124!              !    name   !           title of the field              !   units    ! initial data ! save   ! 
    … …  
    4851/ 
    4952!----------------------------------------------------------------------- 
     53&namtrc_dta      !    Initialisation from data input file 
     54!----------------------------------------------------------------------- 
     55! 
     56!                !  file name               ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     57!                !                          !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     58   sn_trcdta(1)  = 'data_DIC_nomask'        ,        -12        ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     59   sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12        ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , '' 
     60   sn_trcdta(3)  = 'data_O2_nomask'         ,        -1         ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , '' 
     61   sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1         ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , '' 
     62   sn_trcdta(7)  = 'data_Si_nomask'         ,        -1         ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , '' 
     63   sn_trcdta(10) = 'data_DOC_nomask'        ,        -12        ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     64   sn_trcdta(14) = 'data_Fer_nomask'        ,        -12        ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     65   sn_trcdta(23) = 'data_NO3_nomask'        ,        -1         ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , '' 
     66! 
     67   cn_dir        =  './'      !  root directory for the location of the data files 
     68   rn_trfac(1)   =   1.0e-06  !  multiplicative factor 
     69   rn_trfac(2)   =   1.0e-06  !  -      -      -     - 
     70   rn_trfac(3)   =  44.6e-06  !  -      -      -     - 
     71   rn_trfac(5)   = 122.0e-06  !  -      -      -     - 
     72   rn_trfac(7)   =   1.0e-06  !  -      -      -     - 
     73   rn_trfac(10)  =   1.0      !  -      -      -     - 
     74   rn_trfac(14)  =   1.0      !  -      -      -     - 
     75   rn_trfac(23)  =   7.6e-06  !  -      -      -     - 
     76/ 
     77!----------------------------------------------------------------------- 
    5078&namtrc_adv    !   advection scheme for passive tracer  
    5179!----------------------------------------------------------------------- 
    … …  
    6997   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp") 
    7098!                               !  Coefficient 
     99   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    71100   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s] 
    72101/ 
    … …  
    83112/ 
    84113!----------------------------------------------------------------------- 
    85 &namtrc_dmp    !   passive tracer newtonian damping    ('key_tradmp && key_trcdmp') 
     114&namtrc_dmp    !   passive tracer newtonian damping    
    86115!----------------------------------------------------------------------- 
     116   ln_trcdmp   =  .false.  !  add a damping termn (T) or not (F) 
    87117   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    88118                           !                   =XX, damping poleward of XX degrees (XX>0) 
    … …  
    107137   ln_trdtrc(1)  =   .true. 
    108138   ln_trdtrc(2)  =   .true. 
    109    ln_trdtrc(3)  =   .false. 
    110    ln_trdtrc(4)  =   .false. 
    111    ln_trdtrc(5)  =   .false. 
    112    ln_trdtrc(6)  =   .false. 
    113    ln_trdtrc(7)  =   .false. 
    114    ln_trdtrc(8)  =   .false. 
    115    ln_trdtrc(9)  =   .false. 
    116    ln_trdtrc(10) =   .false. 
    117    ln_trdtrc(11) =   .false. 
    118    ln_trdtrc(12) =   .false. 
    119    ln_trdtrc(13) =   .false. 
    120    ln_trdtrc(14) =   .false. 
    121    ln_trdtrc(15) =   .false. 
    122    ln_trdtrc(16) =   .false. 
    123    ln_trdtrc(17) =   .false. 
    124    ln_trdtrc(18) =   .false. 
    125    ln_trdtrc(19) =   .false. 
    126    ln_trdtrc(20) =   .false. 
    127    ln_trdtrc(21) =   .false. 
    128    ln_trdtrc(22) =   .false. 
    129139   ln_trdtrc(23) =   .true. 
    130    ln_trdtrc(24) =   .false. 
    131140/ 
     141!----------------------------------------------------------------------- 
     142&namtrc_dia       !   parameters for passive tracer additional diagnostics 
     143!---------------------------------------------------------------------- 
     144   ln_diatrc     =  .true.   !  save additional diag. (T) or not (F) 
     145   nn_writedia   =  5475     !  time step frequency for diagnostics 
     146/ 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm

    r2670 r2977  
    1 bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_top key_pisces key_dtatrc key_diatrc key_iomput  
     1bld::tool::fppkeys key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_top key_pisces key_iomput  

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r2715 r2977  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/OPA  :  1 - run manager      (namrun) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
     3!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    55!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf,  
    … …  
    2525!----------------------------------------------------------------------- 
    2626   nn_no       =       0   !  job number 
    27    cn_exp      =  "ORCA2P"  !  experience name  
     27   cn_exp      =  "PISCES"  !  experience name  
    2828   nn_it000    =       1   !  first time step 
    2929   nn_itend    =    1460   !  last  time step (std 5475) 
    30    nn_date0    =  010101   !  initial calendar date yymmdd (used if nrstdt=1) 
     30   nn_date0    =  010101   !  initial calendar date yymmdd (used if nn_rstctl=1) 
    3131   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
     32   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
     33   nn_rstctl   =       0       !  restart control = 0 nn_it000 is not compared to the restart file value 
     34                               !                  = 1 use nn_date0 in namelist (not the value in the restart file) 
     35                               !                  = 2 calendar parameters read in the restart file 
     36   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input) 
     37   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output) 
    3238   nn_istate   =       0   !  output the initial state (1) or not (0) 
    3339   nn_stock    =    1460   !  frequency of creation of a restart file (modulo referenced to 1) 
    34    nn_write    =    1460   !  frequency of write in the output file   (modulo referenced to nit000) 
     40   nn_write    =    1460   !  frequency of write in the output file   (modulo referenced to nn_it000) 
    3541   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T) 
    3642   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%) 
    3743   ln_clobber  = .false.   !  clobber (overwrite) an existing file 
    38    nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (working only with iom_nf90 routines) 
    39    ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    40    nn_rstctl   =       0       !  restart control = 0 nit000 is not compared to the restart file value 
    41                                !                  = 1 use ndate0 in namelist (not the value in the restart file) 
    42                                !                  = 2 calendar parameters read in the restart file 
    43    cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input) 
    44    cn_ocerst_out = "restart"   !  suffix of ocean restart name (output) 
     44   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
    4545/ 
    4646 
    … …  
    5151!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5252!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    53 !!   namdta_tem   data: temperature                                     ("key_dtatem") 
    54 !!   namdta_sal   data: salinity                                        ("key_dtasal") 
     53!!   namtsd       data: temperature & salinity                          
    5554!!====================================================================== 
    5655! 
    … …  
    6766   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m) 
    6867   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
    69    rn_theta    =    6.0    !  surface control parameter (0<=theta<=20) 
    70    rn_thetb    =    0.75   !  bottom control parameter  (0<=thetb<= 1) 
    71    rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<r_max<1) 
     68   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20) 
     69   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1) 
     70   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1) 
    7271   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates 
    7372   rn_bb       =    0.8    !  stretching with s-sigma 
    … …  
    7877!----------------------------------------------------------------------- 
    7978   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file 
    80    nn_closea   =    0      !  closed seas and lakes are removed (=0) or kept (=1) from the ORCA domain 
    81    nn_msh      =    1      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0) 
    82    rn_hmin     =   -3.     !  minimum depth of the ocean (>0) or minimum number of ocean level (<0) 
    83    rn_e3zps_min=   20.     !  the thickness of the partial step is set larger than the minimum 
    84    rn_e3zps_rat=    0.1    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1) 
     79   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA) 
     80   nn_msh      =    1      !  create (=1) a mesh file or not (=0) 
     81   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0) 
     82   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of 
     83   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1 
    8584                           ! 
    86    rn_rdt      = 21600.     !  time step for the dynamics (and tracer if nacc=0)   ==> 5760 
    87    nn_baro     =   64      !  number of barotropic time step (for the split explicit algorithm) ("key_dynspg_ts") 
     85   rn_rdt      = 21600.    !  time step for the dynamics (and tracer if nn_acc=0) 
     86   nn_baro     =   64      !  number of barotropic time step           ("key_dynspg_ts") 
    8887   rn_atfp     =    0.1    !  asselin time filter parameter 
    8988   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k) 
    9089                                 !                          =0, not used, rdt = rdttra 
    91    rn_rdtmin   = 21600.          !  minimum time step on tracers (used if nacc=1) 
    92    rn_rdtmax   = 21600.          !  maximum time step on tracers (used if nacc=1) 
    93    rn_rdth     =  800.           !  depth variation of tracer time step  (used if nacc=1) 
    94 / 
    95 !----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     90   rn_rdtmin   = 21600.          !  minimum time step on tracers (used if nn_acc=1) 
     91   rn_rdtmax   = 21600.          !  maximum time step on tracers (used if nn_acc=1) 
     92   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1) 
     93/ 
     94!----------------------------------------------------------------------- 
     95&namtsd    !   data : Temperature  & Salinity                            
     96!----------------------------------------------------------------------- 
     97!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     98!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     99   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     100   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101101   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     102   cn_dir        = './'     !  root directory for the location of the runoff files 
     103   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     104   ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     105/ 
    114106!!====================================================================== 
    115107!!            ***  Surface Boundary Condition namelists  *** 
    … …  
    132124&namsbc        !   Surface Boundary Condition (surface module) 
    133125!----------------------------------------------------------------------- 
    134    nn_fsbc     =  1        !  frequency of surface boundary condition computation  
     126   nn_fsbc     = 1         !  frequency of surface boundary condition computation  
    135127                           !     (also = the frequency of sea-ice model call) 
    136128   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana )  
    … …  
    143135                           !  =1 use observed ice-cover      , 
    144136                           !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
    145    ln_dm2dc    = .false.   !  daily mean to diurnal cycle short wave (qsr) 
     137   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    146138   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
    147139   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    … …  
    192184&namsbc_core   !   namsbc_core  CORE bulk formulea 
    193185!----------------------------------------------------------------------- 
    194 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
    195 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
    196    sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd' 
    197    sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd' 
    198    sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , '' 
    199    sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , '' 
    200    sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , '' 
    201    sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , '' 
    202    sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , '' 
    203    sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , '' 
    204    sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , '' 
     186!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     187!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     188   sn_wndi     = 'u_10.15JUNE2009_orca2'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd' 
     189   sn_wndj     = 'v_10.15JUNE2009_orca2'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd' 
     190   sn_qsr      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , '' 
     191   sn_qlw      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , '' 
     192   sn_tair     = 't_10.15JUNE2009_orca2'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , '' 
     193   sn_humi     = 'q_10.15JUNE2009_orca2'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , '' 
     194   sn_prec     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , '' 
     195   sn_snow     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , '' 
     196   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , '' 
    205197 
    206198   cn_dir      = './'      !  root directory for the location of the bulk files 
    207199   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F) 
    208    ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data ? 
     200   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data 
    209201   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    210202/ 
    … …  
    237229&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle") 
    238230!----------------------------------------------------------------------- 
    239 cn_snd_co2        = 'coupled'         ! send    : 'none' 'coupled' 
    240 cn_rcv_co2        = 'coupled'         ! receive : 'none' 'coupled' 
     231   cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled' 
     232   cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled' 
    241233/ 
    242234!----------------------------------------------------------------------- 
    … …  
    260252&namsbc_rnf    !   runoffs namelist surface boundary condition 
    261253!----------------------------------------------------------------------- 
    262 !              !  file name              ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
    263 !              !                         !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
    264    sn_rnf      = 'runoff_core_monthly'   ,        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , '' 
    265    sn_cnf      = 'runoff_core_monthly'   ,         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , '' 
    266    sn_s_rnf    = 'runoffs'               ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , '' 
    267    sn_t_rnf    = 'runoffs'               ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , '' 
    268    sn_dep_rnf  = 'runoffs'               ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , '' 
     254!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     255!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     256   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , '' 
     257   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , '' 
     258   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , '' 
     259   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , '' 
     260   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , '' 
    269261 
    270262   cn_dir       = './'      !  root directory for the location of the runoff files 
    271    ln_rnf_emp   =   .false. !  runoffs included into precipitation field (T) or into a file (F) 
    272    ln_rnf_mouth =   .false. !  specific treatment at rivers mouths 
     263   ln_rnf_emp   = .false.  !  runoffs included into precipitation field (T) or into a file (F) 
     264   ln_rnf_mouth = .true.    !  specific treatment at rivers mouths 
    273265   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used 
    274266   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s] 
    275267   rn_rfact     =   1.e0    !  multiplicative factor for runoff 
    276    ln_rnf_depth =  .false.  !  read in depth information for runoff 
    277    ln_rnf_tem   =  .false.  !  read in temperature information for runoff 
    278    ln_rnf_sal   =  .false.  !  read in salinity information for runoff 
     268   ln_rnf_depth = .false.   !  read in depth information for runoff 
     269   ln_rnf_tem   = .false.   !  read in temperature information for runoff 
     270   ln_rnf_sal   = .false.   !  read in salinity information for runoff 
    279271/ 
    280272!----------------------------------------------------------------------- 
    … …  
    301293                           !  or to SSS only (=1) or no damping term (=0) 
    302294   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K] 
    303    rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day] 
     295   rn_deds     =  -166.67  !  magnitude of the damping on salinity   [mm/day] 
    304296   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2) 
    305297   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day] 
    … …  
    355347   rn_dpnob    = 3000.     !     -           -         -     north   -      - 
    356348   rn_dpsob    =   15.     !     -           -         -     south   -      - 
    357    rn_volemp   =  1.       !  = 0 the total volume change with the surface flux (E-P-R) 
     349   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R) 
    358350                           !  = 1 the total volume remains constant 
    359351/ 
    … …  
    361353&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    362354!----------------------------------------------------------------------- 
    363    nn_cln_update = 3       !  baroclinic update frequency 
     355   nn_cln_update =    3    !  baroclinic update frequency 
    364356   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    365    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [s] 
    366    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [s] 
     357   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s] 
     358   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s] 
    367359/ 
    368360!----------------------------------------------------------------------- 
    369361&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    370362!----------------------------------------------------------------------- 
    371    cn_mask       =  ''                     !  name of mask file (if ln_bdy_mask=.TRUE.) 
    372    cn_dta_frs_T  = 'bdydata_grid_T.nc'     !  name of data file (T-points) 
    373    cn_dta_frs_U  = 'bdydata_grid_U.nc'     !  name of data file (U-points) 
    374    cn_dta_frs_V  = 'bdydata_grid_V.nc'     !  name of data file (V-points) 
    375    cn_dta_fla_T  = 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points) 
    376    cn_dta_fla_U  = 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points) 
    377    cn_dta_fla_V  = 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points) 
     363   cn_mask     =  ''                     !  name of mask file (ln_mask=T) 
     364   cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points) 
     365   cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points) 
     366   cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points) 
     367   cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points) 
     368   cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points) 
     369   cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points) 
    378370 
    379371   ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic 
    … …  
    414406   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case) 
    415407   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case) 
    416    rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2) 
    417    ln_bfr2d    =   .false. !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
    418    rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d = .true.) 
     408   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2) 
     409   ln_bfr2d    = .false.  !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
     410   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T) 
    419411/ 
    420412!----------------------------------------------------------------------- 
    421413&nambbc        !   bottom temperature boundary condition 
    422414!----------------------------------------------------------------------- 
    423    ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
     415   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    424416   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux  
    425417                           !     = 1 constant flux 
    … …  
    442434!!   namtra_adv    advection scheme 
    443435!!   namtra_ldf    lateral diffusion scheme 
    444 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp") 
    445 !!====================================================================== 
    446  
     436!!   namtra_dmp    T & S newtonian damping                         
     437!!====================================================================== 
     438! 
    447439!----------------------------------------------------------------------- 
    448440&nameos        !   ocean physical parameters 
    449441!----------------------------------------------------------------------- 
    450    nn_eos      =    0      !  type of equation of state and Brunt-Vaisala frequency 
     442   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency 
    451443                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) ) 
    452444                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T ) 
    453445                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T ) 
    454    rn_alpha    =    2.e-4  !  thermal expension coefficient (neos= 1 or 2) 
    455    rn_beta     =    0.001  !  saline  expension coefficient (neos= 2) 
     446   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2) 
     447   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2) 
    456448/ 
    457449!----------------------------------------------------------------------- 
    … …  
    483475/ 
    484476!----------------------------------------------------------------------- 
    485 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp') 
    486 !----------------------------------------------------------------------- 
     477&namtra_dmp    !   tracer: T & S newtonian damping                   
     478!----------------------------------------------------------------------- 
     479   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F) 
    487480   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    488481                           !                   =XX, damping poleward of XX degrees (XX>0) 
    489482                           !                      + F(distance-to-coast) + Red and Med Seas 
    490    nn_zdmp     =    1      !  vertical   shape =0    damping throughout the water column 
     483   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column 
    491484                           !                   =1 no damping in the mixing layer (kz  criteria) 
    492485                           !                   =2 no damping in the mixed  layer (rho crieria) 
    … …  
    505498!!   namdyn_spg    surface pressure gradient                            (CPP key only) 
    506499!!   namdyn_ldf    lateral diffusion scheme 
    507 !!   namdyn        offline: dynamics read in files                      ("key_offline") 
    508500!!====================================================================== 
    509501! 
    … …  
    560552/ 
    561553!----------------------------------------------------------------------- 
    562 &namdyn        !   offline dynamics read in files                       ("key_offline") 
    563 !----------------------------------------------------------------------- 
    564     ndtadyn   =  73        ! number of period in the file for one year 
    565     ndtatot   =  73        ! total number of period in the file 
    566     nsptint   =  1         ! indicator for time interpolation 
    567     lperdyn   = .true.     ! periodicity of the unique file (T) 
    568                            ! F  (default)   computed with Blanke' scheme 
    569     cfile_grid_T = 'dyna_grid_T.nc' ! name of grid_T file 
    570     cfile_grid_U = 'dyna_grid_U.nc' ! name of grid_U file 
    571     cfile_grid_V = 'dyna_grid_V.nc' ! name of grid_V file 
    572     cfile_grid_W = 'dyna_grid_W.nc' ! name of grid_W file 
    573 / 
    574  
     554&namdta_dyn        !   offline dynamics read in files                ("key_offline") 
     555!----------------------------------------------------------------------- 
     556!            !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     557!            !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     558   sn_tem  = 'dyna_grid_T' ,    120            , 'votemper' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     559   sn_sal  = 'dyna_grid_T' ,    120            , 'vosaline' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     560   sn_mld  = 'dyna_grid_T' ,    120            , 'somixhgt' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     561   sn_emp  = 'dyna_grid_T' ,    120            , 'sowaflcd' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     562   sn_ice  = 'dyna_grid_T' ,    120            , 'soicecov' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     563   sn_qsr  = 'dyna_grid_T' ,    120            , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     564   sn_wnd  = 'dyna_grid_T' ,    120            , 'sowindsp' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     565   sn_uwd  = 'dyna_grid_U' ,    120            , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     566   sn_vwd  = 'dyna_grid_V' ,    120            , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     567   sn_wwd  = 'dyna_grid_W' ,    120            , 'vovecrtz' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     568   sn_avt  = 'dyna_grid_W' ,    120            , 'voddmavs' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     569   sn_ubl  = 'dyna_grid_U' ,    120            , 'sobblcox' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     570   sn_vbl  = 'dyna_grid_V' ,    120            , 'sobblcoy' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     571   sn_eiw  = 'dyna_grid_W' ,    120            , 'soleaeiw' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     572! 
     573   cn_dir      = './'      !  root directory for the location of the dynamical files 
     574   ln_degrad   =  .false.  !  flag for degradation -                requires ("key_degrad") 
     575   ln_dynwzv   =  .true.   !  computation of vertical velocity instead of using the one read in file 
     576   ln_dynbbl   =  .true.   !  bbl coef are in files, so read them - requires ("key_trabbl") 
     577/ 
    575578!!====================================================================== 
    576579!!             Tracers & Dynamics vertical physics namelists 
    … …  
    594597   nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1) 
    595598   rn_avevd    =  100.     !  evd mixing coefficient [m2/s] 
    596    ln_zdfnpc   = .false.   !  Non-Penetrative algorithm (T) or not (F) 
     599   ln_zdfnpc   = .false.   !  Non-Penetrative Convective algorithm (T) or not (F) 
    597600   nn_npc      =    1            !  frequency of application of npc 
    598601   nn_npcp     =  365            !  npc control print frequency 
    … …  
    635638/ 
    636639!------------------------------------------------------------------------ 
    637 &namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionnally: 
     640&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally: 
    638641!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb") 
    639642   ln_kpprimix = .true.    !  shear instability mixing  
    … …  
    654657   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988) 
    655658   rn_clim_galp  = 0.53    !  galperin limit 
    656    ln_crban      = .TRUE.  !  Use Craig & Banner (1994) surface wave mixing parametrisation 
    657    ln_sigpsi     = .TRUE.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case 
     659   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation 
     660   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case 
    658661   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux 
    659662   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length 
    … …  
    678681   rn_tfe      = 0.333     !  tidal dissipation efficiency 
    679682   rn_me       = 0.2       !  mixing efficiency  
    680    ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation 
     683   ln_tmx_itf  = .true.    !  ITF specific parameterisation 
    681684   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency 
    682685/ 
    683686 
    684687!!====================================================================== 
    685 !!                  ***  Miscelaneous namelists  *** 
     688!!                  ***  Miscellaneous namelists  *** 
    686689!!====================================================================== 
    687690!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    … …  
    746749                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which 
    747750                           !  is optimal for postprocessing which works exclusively with horizontal slabs 
    748    ln_nc4zip   = .TRUE.    !  (T) use netcdf4 chunking and compression 
     751   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression 
    749752                           !  (F) ignore chunking information and produce netcdf3-compatible files 
    750753/ 
    … …  
    770773   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T) 
    771774                           !  or computed with Blanke' scheme (F) 
    772                            !  or computed with Blanke' scheme (F) 
    773775/ 
    774776!----------------------------------------------------------------------- 
    … …  
    776778!----------------------------------------------------------------------- 
    777779   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F) 
    778    ln_diaznl  = .false.    !  Add zonal means and meridional stream functions 
    779    ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not  
     780   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions 
     781   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not  
    780782                           !  (orca configuration only, need input basins mask file named "subbasins.nc" 
    781    ln_ptrcomp = .false.    !  Add decomposition : overturning 
     783   ln_ptrcomp = .true.     !  Add decomposition : overturning 
    782784   nn_fptr    =  1         !  Frequency of ptr computation [time step] 
    783785   nn_fwri    =  15        !  Frequency of ptr outputs [time step] 
    … …  
    786788&namhsb       !  Heat and salt budgets  
    787789!----------------------------------------------------------------------- 
    788    ln_diahsb  = .false.     !  check the heat and salt budgets (T) or not (F) 
     790   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F) 
    789791/ 
    790792 
    … …  
    797799! 
    798800!----------------------------------------------------------------------- 
    799  &namobs      !  observation usage switch                               ('key_diaobs') 
     801&namobs       !  observation usage switch                               ('key_diaobs') 
    800802!----------------------------------------------------------------------- 
    801803   ln_t3d     = .false.    ! Logical switch for T profile observations          

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces

    r2567 r2977  
    1515&nampisext     !   air-sea exchange 
    1616!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    17    atcco2     = 287.    ! atmospheric pCO2 
     17   ln_co2int  =  .false. ! read atm pco2 from a file (T) or constant (F) 
     18   atcco2     =  287.    ! Constant value atmospheric pCO2 - ln_co2int = F 
     19   clname     =  'atcco2.txt'  ! Name of atm pCO2 file - ln_co2int = T 
     20   nn_offset  =  0       ! Offset model-data start year - ln_co2int = T 
     21!                        ! If your model year is iyy, nn_offset=(years(1)-iyy)  
     22!                        ! then the first atmospheric CO2 record read is at years(1) 
     23/ 
     24!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     25&nampisatm     !  Atmospheric prrssure  
     26!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     27!              !  file name   ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     28!              !              !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     29   sn_patm     = 'presatm'    ,     -1            , 'patm'     ,  .true.      , .true. ,   'yearly'  , ''       , '' 
     30   cn_dir      = './'      !  root directory for the location of the dynamical files 
    1831/ 
    1932!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    2033&nampisbio     !   biological parameters 
    2134!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    22    part       =  0.85    ! part of calcite not dissolved in guts 
    2335   nrdttrc    =  4       ! time step frequency for biology 
    2436   wsbio      =  2.      ! POC sinking speed 
    2537   xkmort     =  1.E-7   ! half saturation constant for mortality 
    26    ferat3     =  3.E-6   ! Fe/C in zooplankton  
     38   ferat3     =  10.E-6  ! Fe/C in zooplankton  
    2739   wsbio2     =  30.     ! Big particles sinking speed 
    2840/ 
    … …  
    3143!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    3244   conc0      =  2.e-6    ! Phosphate half saturation 
    33    conc1      =  10E-6    ! Phosphate half saturation for diatoms 
    34    conc2      =  0.01E-9  ! Iron half saturation for phyto 
    35    conc2m     =  0.08E-9  ! Max iron half saturation for phyto 
    36    conc3      =  0.1E-9   ! Iron half saturation for diatoms 
    37    conc3m     =  0.4E-9   ! Maxi iron half saturation for diatoms 
     45   conc1      =  8E-6     ! Phosphate half saturation for diatoms 
     46   conc2      =  1E-9     ! Iron half saturation for phyto 
     47   conc2m     =  3E-9     ! Max iron half saturation for phyto 
     48   conc3      =  2E-9     ! Iron half saturation for diatoms 
     49   conc3m     =  8E-9     ! Maxi iron half saturation for diatoms 
     50   xsizedia   =  5.E-7    ! Minimum size criteria for diatoms 
     51   xsizephy   =  1.E-6    ! Minimum size criteria for phyto 
    3852   concnnh4   =  1.E-7    ! NH4 half saturation for phyto 
    39    concdnh4   =  5.E-7    ! NH4 half saturation for diatoms 
     53   concdnh4   =  4.E-7    ! NH4 half saturation for diatoms 
    4054   xksi1      =  2.E-6    ! half saturation constant for Si uptake 
    4155   xksi2      =  3.33E-6  ! half saturation constant for Si/C 
    4256   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization 
    43    caco3r     =  0.15     ! mean rain ratio 
     57   concfebac  =  3.E-11   ! Half-saturation for Fe limitation of Bacteria 
     58   qnfelim    =  7.E-6    ! Optimal quota of phyto 
     59   qdfelim    =  7.E-6    ! Optimal quota of diatoms 
     60   caco3r     =  0.16     ! mean rain ratio 
    4461/ 
    4562!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    4663&nampisprod     !   parameters for phytoplankton growth 
    4764!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    48    pislope    =  3.       ! P-I slope   
    49    pislope2   =  3.       ! P-I slope  for diatoms 
     65   pislope    =  2.       ! P-I slope 
     66   pislope2   =  2.       ! P-I slope  for diatoms 
    5067   excret     =  0.05     ! excretion ratio of phytoplankton 
    5168   excret2    =  0.05     ! excretion ratio of diatoms 
     69   ln_newprod =  .FALSE.  ! Enable new parame. of production (T/F)  
     70   bresp      =  0.00333  ! Basal respiration rate 
    5271   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton 
    53    chlcdm     =  0.05     ! Minimum Chl/C in diatoms 
    54    fecnm      =  10E-6    ! Maximum Fe/C in nanophytoplankton 
    55    fecdm      =  15E-6    ! Minimum Fe/C in diatoms 
     72   chlcdm     =  0.04     ! Minimum Chl/C in diatoms 
     73   chlcmin    =  0.0033   ! Maximum Chl/c in phytoplankton 
     74   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton 
     75   fecdm      =  40E-6    ! Minimum Fe/C in diatoms 
    5676   grosip     =  0.151    ! mean Si/C ratio 
    5777/ 
    … …  
    6888&nampismes     !   parameters for mesozooplankton 
    6989!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    70    grazrat2   =  0.7      ! maximal mesozoo grazing rate 
     90   part2      =  0.75    ! part of calcite not dissolved in mesozoo guts 
     91   grazrat2   =  0.9      ! maximal mesozoo grazing rate 
    7192   resrat2    =  0.005    ! exsudation rate of mesozooplankton 
    72    mzrat2     =  0.03     ! mesozooplankton mortality rate 
     93   mzrat2     =  0.04     ! mesozooplankton mortality rate 
    7394   xprefc     =  1.       ! zoo preference for phyto 
    74    xprefp     =  0.2      ! zoo preference for POC 
     95   xprefp     =  0.3      ! zoo preference for POC 
    7596   xprefz     =  1.       ! zoo preference for zoo 
    76    xprefpoc   =  0.2      ! zoo preference for poc 
     97   xprefpoc   =  0.3      ! zoo preference for poc 
     98   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton  
     99   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton  
     100   xthresh2phy = 2E-7     ! nanophyto feeding threshold for mesozooplankton  
     101   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton  
     102   xthresh2   =  0.       ! Food threshold for grazing 
    77103   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing 
    78    epsher2    =  0.33     ! Efficicency of Mesozoo growth  
     104   epsher2    =  0.3      ! Efficicency of Mesozoo growth 
    79105   sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM 
    80106   unass2     =  0.3      ! non assimilated fraction of P by mesozoo 
    81    grazflux   =  5.e3     ! flux-feeding rate 
     107   grazflux   =  3.e3     ! flux-feeding rate 
    82108/ 
    83109!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    84110&nampiszoo     !   parameters for microzooplankton 
    85111!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    86    grazrat    =  4.0      ! maximal zoo grazing rate    
     112   part       =  0.5      ! part of calcite not dissolved in microzoo gutsa 
     113   grazrat    =  3.0      ! maximal zoo grazing rate 
    87114   resrat     =  0.03     ! exsudation rate of zooplankton 
    88115   mzrat      =  0.0      ! zooplankton mortality rate 
    89    xpref2c    =  0.1      ! Microzoo preference for POM  
    90    xpref2p    =  0.45     ! Microzoo preference for Nanophyto 
    91    xpref2d    =  0.45     ! Microzoo preference for Diatoms 
    92    xkgraz     =  20.E-6   ! half sturation constant for grazing  
    93    epsher     =  0.33     ! Efficiency of microzoo growth 
     116   xpref2c    =  0.2      ! Microzoo preference for POM 
     117   xpref2p    =  1.       ! Microzoo preference for Nanophyto 
     118   xpref2d    =  0.6      ! Microzoo preference for Diatoms 
     119   xthreshdia =  1.E-8    ! Diatoms feeding threshold for microzooplankton  
     120   xthreshphy =  2.E-7    ! Nanophyto feeding threshold for microzooplankton  
     121   xthreshpoc =  1.E-8    ! POC feeding threshold for microzooplankton  
     122   xthresh    =  0.       ! Food threshold for feeding 
     123   xkgraz     =  20.E-6   ! half sturation constant for grazing 
     124   epsher     =  0.3      ! Efficiency of microzoo growth 
    94125   sigma1     =  0.6      ! Fraction of microzoo excretion as DOM 
    95126   unass      =  0.3      ! non assimilated fraction of phyto by zoo 
    … …  
    98129&nampisrem     !   parameters for remineralization 
    99130!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    100    xremik    =  0.3       ! remineralization rate of DOC 
     131   xremik    =  0.25      ! remineralization rate of DOC 
    101132   xremip    =  0.025     ! remineralisation rate of POC 
    102133   nitrif    =  0.05      ! NH4 nitrification rate 
    103    xsirem    =  0.015     ! remineralization rate of Si 
     134   xsirem    =  0.003     ! remineralization rate of Si 
     135   xsiremlab =  0.025     ! fast remineralization rate of Si 
     136   xsilab    =  0.31      ! Fraction of labile biogenic silica 
    104137   xlam1     =  0.005     ! scavenging rate of Iron 
    105    oxymin    =  1.E-6     ! Half-saturation constant for anoxia  
     138   oxymin    =  1.E-6     ! Half-saturation constant for anoxia 
     139   ligand    =  0.6E-9    ! Ligands concentration 
    106140/ 
    107141!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    108142&nampiscal     !   parameters for Calcite chemistry 
    109143!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    110    kdca       =  0.327e3  ! calcite dissolution rate constant (1/time) 
     144   kdca       =  6.       ! calcite dissolution rate constant (1/time) 
    111145   nca        =  1.       ! order of dissolution reaction (dimensionless) 
    112146/ 
    … …  
    114148&nampissed     !   parameters for inputs deposition 
    115149!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    116    ln_dustfer  =  .true.   ! boolean for dust input from the atmosphere 
    117    ln_river    =  .true.   ! boolean for river input of nutrients 
     150!              !  file name        ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     151!              !                   !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     152   sn_dust     = 'dust.orca'       ,     -1            , 'dust'     ,  .true.      , .true. ,   'yearly'  , ''       , '' 
     153   sn_riverdic = 'river.orca'      ,    -12            , 'riverdic' ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     154   sn_riverdoc = 'river.orca'      ,    -12            , 'riverdoc' ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     155   sn_ndepo    = 'ndeposition.orca',    -12            , 'ndep'     ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     156   sn_ironsed  = 'bathy.orca'      ,    -12            , 'bathy'    ,  .false.     , .true. ,   'yearly'  , ''       , '' 
     157! 
     158   cn_dir      = './'      !  root directory for the location of the dynamical files 
     159   ln_dust     =  .true.   ! boolean for dust input from the atmosphere 
     160   ln_river    =  .false.   ! boolean for river input of nutrients 
    118161   ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N 
    119    ln_sedinput =  .true.   ! boolean for Fe input from sediments 
     162   ln_ironsed =  .true.   ! boolean for Fe input from sediments 
    120163   sedfeinput  =  1E-9     ! Coastal release of Iron 
    121    dustsolub   =  0.014    ! Solubility of the dust 
     164   dustsolub   =  0.02     ! Solubility of the dust 
     165   wdust       =  2.0      ! Dust sinking speed 
     166   nitrfix     =  1E-7     ! Nitrogen fixation rate 
     167   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2) 
     168   concfediaz  =  1.E-10   ! Diazotrophs half-saturation Cste for Iron 
    122169/ 
    123170!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    … …  
    140187/ 
    141188!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    142 &nampisdia     !   additional 2D/3D tracers diagnostics ("key_trc_diaadd") 
    143 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    144    nn_writedia  =  1460   !  time step frequency for tracers diagnostics 
    145 ! 
     189&nampisdia     !   additional 2D/3D tracers diagnostics  
     190!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    146191!              !    name   !           title of the field          !     units      ! 
    147192!              !           !                                       !                !   
    … …  
    175220!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    176221   ln_pisdmp    =  .true.     !  Relaxation fo some tracers to a mean value 
    177    ln_pisclo    =  .false.    !  Restoring of tracer to initial value on closed sea ("key_dtatrc") 
    178 / 
     222   nn_pisdmp    =  1460       !  Frequency of Relaxation  
     223/ 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top

    r2528 r2977  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    ) 
    3 !! namelists    2 - dynamical tracer trends               (namtrc_trd) 
     3!!              2 - tracer data initialisation            (namtrc_dta) 
    44!!              3 - tracer advection                      (namtrc_adv) 
    55!!              4 - tracer lateral diffusion              (namtrc_ldf) 
    66!!              5 - tracer vertical physics               (namtrc_zdf) 
    77!!              6 - tracer newtonian damping              (namtrc_dmp) 
     8!!              7 - dynamical tracer trends               (namtrc_trd) 
     9!!              8 - tracer output diagonstics             (namtrc_dia) 
    810!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    911!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    … …  
    1820   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
    1921   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     22   ln_trcdta     =   .true. !  Initialisation from data input file (T) or not (F) 
    2023! 
    2124!              !    name   !           title of the field              !   units    ! initial data ! save   ! 
    … …  
    4851/ 
    4952!----------------------------------------------------------------------- 
     53&namtrc_dta      !    Initialisation from data input file 
     54!----------------------------------------------------------------------- 
     55! 
     56!                !  file name               ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! 
     57!                !                          !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! 
     58   sn_trcdta(1)  = 'data_DIC_nomask'        ,        -12        ,  'DIC'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     59   sn_trcdta(2)  = 'data_Alkalini_nomask'   ,        -12        ,  'Alkalini',    .false.   , .true. , 'yearly'  , ''       , '' 
     60   sn_trcdta(3)  = 'data_O2_nomask'         ,        -1         ,  'O2'      ,    .true.    , .true. , 'yearly'  , ''       , '' 
     61   sn_trcdta(5)  = 'data_PO4_nomask'        ,        -1         ,  'PO4'     ,    .true.    , .true. , 'yearly'  , ''       , '' 
     62   sn_trcdta(7)  = 'data_Si_nomask'         ,        -1         ,  'Si'      ,    .true.    , .true. , 'yearly'  , ''       , '' 
     63   sn_trcdta(10) = 'data_DOC_nomask'        ,        -12        ,  'DOC'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     64   sn_trcdta(14) = 'data_Fer_nomask'        ,        -12        ,  'Fer'     ,    .false.   , .true. , 'yearly'  , ''       , '' 
     65   sn_trcdta(23) = 'data_NO3_nomask'        ,        -1         ,  'NO3'     ,    .true.    , .true. , 'yearly'  , ''       , '' 
     66! 
     67   cn_dir        =  './'      !  root directory for the location of the data files 
     68   rn_trfac(1)   =   1.0e-06  !  multiplicative factor 
     69   rn_trfac(2)   =   1.0e-06  !  -      -      -     - 
     70   rn_trfac(3)   =  44.6e-06  !  -      -      -     - 
     71   rn_trfac(5)   = 122.0e-06  !  -      -      -     - 
     72   rn_trfac(7)   =   1.0e-06  !  -      -      -     - 
     73   rn_trfac(10)  =   1.0      !  -      -      -     - 
     74   rn_trfac(14)  =   1.0      !  -      -      -     - 
     75   rn_trfac(23)  =   7.6e-06  !  -      -      -     - 
     76/ 
     77!----------------------------------------------------------------------- 
    5078&namtrc_adv    !   advection scheme for passive tracer  
    5179!----------------------------------------------------------------------- 
    … …  
    6997   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp") 
    7098!                               !  Coefficient 
     99   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s] 
    71100   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s] 
    72101/ 
    … …  
    83112/ 
    84113!----------------------------------------------------------------------- 
    85 &namtrc_dmp    !   passive tracer newtonian damping    ('key_tradmp && key_trcdmp') 
     114&namtrc_dmp    !   passive tracer newtonian damping    
    86115!----------------------------------------------------------------------- 
     116   ln_trcdmp   =  .false.  !  add a damping termn (T) or not (F) 
    87117   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    88118                           !                   =XX, damping poleward of XX degrees (XX>0) 
    … …  
    100130!                          or mixed-layer trends          ('key_trdmld_trc') 
    101131!---------------------------------------------------------------------- 
    102    nn_trd_trc  =  5475      !  time step frequency and tracers trends 
     132   nn_trd_trc  =  1460      !  time step frequency and tracers trends 
    103133   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk) 
    104134   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day) 
    … …  
    107137   ln_trdtrc(1)  =   .true. 
    108138   ln_trdtrc(2)  =   .true. 
    109    ln_trdtrc(3)  =   .false. 
    110    ln_trdtrc(4)  =   .false. 
    111    ln_trdtrc(5)  =   .false. 
    112    ln_trdtrc(6)  =   .false. 
    113    ln_trdtrc(7)  =   .false. 
    114    ln_trdtrc(8)  =   .false. 
    115    ln_trdtrc(9)  =   .false. 
    116    ln_trdtrc(10) =   .false. 
    117    ln_trdtrc(11) =   .false. 
    118    ln_trdtrc(12) =   .false. 
    119    ln_trdtrc(13) =   .false. 
    120    ln_trdtrc(14) =   .false. 
    121    ln_trdtrc(15) =   .false. 
    122    ln_trdtrc(16) =   .false. 
    123    ln_trdtrc(17) =   .false. 
    124    ln_trdtrc(18) =   .false. 
    125    ln_trdtrc(19) =   .false. 
    126    ln_trdtrc(20) =   .false. 
    127    ln_trdtrc(21) =   .false. 
    128    ln_trdtrc(22) =   .false. 
    129139   ln_trdtrc(23) =   .true. 
    130    ln_trdtrc(24) =   .false. 
    131140/ 
     141!----------------------------------------------------------------------- 
     142&namtrc_dia       !   parameters for passive tracer additional diagnostics 
     143!---------------------------------------------------------------------- 
     144   ln_diatrc     =  .true.   !  save additional diag. (T) or not (F) 
     145   nn_writedia   =  1460     !  time step frequency for diagnostics 
     146/ 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm

    r2787 r2977  
    1 bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_dtatrc key_diatrc key_iomput  
     1bld::tool::fppkeys key_trabbl key_orca_r2 key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput  

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/POMME/EXP00/namelist

    r2650 r2977  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/OPA  :  1 - run manager      (namrun) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
     3!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    55!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf,  
    … …  
    5151!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5252!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    53 !!   namdta_tem   data: temperature                                     ("key_dtatem") 
    54 !!   namdta_sal   data: salinity                                        ("key_dtasal") 
     53!!   namtsd       data: temperature & salinity          
    5554!!====================================================================== 
    5655! 
    … …  
    9493/ 
    9594!----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     95&namtsd    !   data : Temperature  & Salinity                            
     96!----------------------------------------------------------------------- 
     97!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     98!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     99   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     100   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101101   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     102   cn_dir        = './'     !  root directory for the location of the runoff files 
     103   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     104   ln_tsd_tradmp = .false.  !  damping of ocean T & S toward T &S input data (T) or not (F) 
     105/ 
    114106!!====================================================================== 
    115107!!            ***  Surface Boundary Condition namelists  *** 
    … …  
    442434!!   namtra_adv    advection scheme 
    443435!!   namtra_ldf    lateral diffusion scheme 
    444 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp") 
     436!!   namtra_dmp    T & S newtonian damping                          
    445437!!====================================================================== 
    446438! 
    … …  
    483475/ 
    484476!----------------------------------------------------------------------- 
    485 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp') 
    486 !----------------------------------------------------------------------- 
     477&namtra_dmp    !   tracer: T & S newtonian damping                     
     478!----------------------------------------------------------------------- 
     479   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F) 
    487480   nn_hdmp     =    1      !  horizontal shape =-1, damping in Med and Red Seas only 
    488481                           !                   =XX, damping poleward of XX degrees (XX>0) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/CONFIG/POMME/cpp_POMME.fcm

    r2670 r2977  
    1 bld::tool::fppkeys key_pomme_r025 key_dynspg_flt key_zdftke key_dtatem key_dtasal key_traldf_c2d key_dynldf_c2d key_ldfslp key_obc key_iomput 
     1bld::tool::fppkeys key_pomme_r025 key_dynspg_flt key_zdftke key_traldf_c2d key_dynldf_c2d key_ldfslp key_obc key_iomput 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90

    r2528 r2977  
    7070      IF( .NOT. ln_limini ) THEN   
    7171          
    72          tfu(:,:) = tfreez( sn(:,:,1) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
     72         tfu(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    7373 
    7474         DO jj = 1, jpj 
    7575            DO ji = 1, jpi 
    7676               !                     ! ice if sst <= t-freez + ttest 
    77                IF( tn(ji,jj,1)  - tfu(ji,jj) >= ttest ) THEN   ;   zidto = 0.e0      ! no ice 
    78                ELSE                                            ;   zidto = 1.e0      !    ice 
     77               IF( tsn(ji,jj,1,jp_tem)  - tfu(ji,jj) >= ttest ) THEN   ;   zidto = 0.e0      ! no ice 
     78               ELSE                                                    ;   zidto = 1.e0      !    ice 
    7979               ENDIF 
    8080               ! 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r2777 r2977  
    9898      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
    9999 
    100       t_bo(:,:) = tfreez( sn(:,:,1) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
     100      t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    101101 
    102102      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    103103         DO ji = 1, jpi 
    104             IF( tn(ji,jj,1)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0.e0      ! no ice 
    105             ELSE                                             ;   zidto(ji,jj) = 1.e0      !    ice 
     104            IF( tsn(ji,jj,1,jp_tem)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0.e0      ! no ice 
     105            ELSE                                                     ;   zidto(ji,jj) = 1.e0      !    ice 
    106106            ENDIF 
    107107         END DO 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r2715 r2977  
    3535   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ??? 
    3636    
    37    INTEGER :: tn_id, sn_id, tb_id, sb_id, ta_id, sa_id 
     37   INTEGER :: tsn_id,tsb_id,tsa_id 
    3838   INTEGER :: un_id, vn_id, ua_id, va_id 
    3939   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r2715 r2977  
    4848      !!---------------------------------------------------------------------- 
    4949      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    50       USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     50      USE wrk_nemo, ONLY: wrk_4d_1 
    5151      !! 
    52       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     52      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    5353      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3 
    5454      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7 
    55       REAL(wp), POINTER, DIMENSION(:,:,:) :: zta, zsa 
     55      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa 
    5656      !!---------------------------------------------------------------------- 
    5757      ! 
    5858      IF( Agrif_Root() )   RETURN 
    5959 
    60       zta => wrk_3d_1 ; zsa => wrk_3d_2 
    61       IF( wrk_in_use(3, 1,2) )THEN 
     60      ztsa => wrk_4d_1  
     61      IF( wrk_in_use(4, 1) )THEN 
    6262         CALL ctl_stop('agrif_tra: requested workspace arrays unavailable.') 
    6363         RETURN 
    … …  
    6666      Agrif_SpecialValue    = 0.e0 
    6767      Agrif_UseSpecialValue = .TRUE. 
    68       zta(:,:,:) = 0.e0 
    69       zsa(:,:,:) = 0.e0 
    70  
    71       CALL Agrif_Bc_variable( zta, tn_id, procname = interptn ) 
    72       CALL Agrif_Bc_variable( zsa, sn_id, procname = interpsn ) 
     68      ztsa(:,:,:,:) = 0.e0 
     69 
     70      CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn ) 
    7371      Agrif_UseSpecialValue = .FALSE. 
    7472 
    … …  
    8785      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    8886 
    89          ta(nlci,:,:) = alpha1 * zta(nlci,:,:) + alpha2 * zta(nlci-1,:,:) 
    90          sa(nlci,:,:) = alpha1 * zsa(nlci,:,:) + alpha2 * zsa(nlci-1,:,:) 
    91  
    92          DO jk = 1, jpkm1 
    93             DO jj = 1, jpj 
    94                IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    95                   ta(nlci-1,jj,jk) = ta(nlci,jj,jk) * tmask(nlci-1,jj,jk) 
    96                   sa(nlci-1,jj,jk) = sa(nlci,jj,jk) * tmask(nlci-1,jj,jk) 
    97                ELSE 
    98                   ta(nlci-1,jj,jk)=(alpha4*ta(nlci,jj,jk)+alpha3*ta(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 
    99                   sa(nlci-1,jj,jk)=(alpha4*sa(nlci,jj,jk)+alpha3*sa(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 
    100                   IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
    101                      ta(nlci-1,jj,jk)=( alpha6*ta(nlci-2,jj,jk)+alpha5*ta(nlci,jj,jk)  & 
    102                         &             + alpha7*ta(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 
    103                      sa(nlci-1,jj,jk)=( alpha6*sa(nlci-2,jj,jk)+alpha5*sa(nlci,jj,jk)  & 
    104                         &             + alpha7*sa(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 
     87         DO jn = 1, jpts 
     88            tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn) 
     89            DO jk = 1, jpkm1 
     90               DO jj = 1, jpj 
     91                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     92                     tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     93                  ELSE 
     94                     tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     95                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     96                        tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  & 
     97                           &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     98                     ENDIF 
    10599                  ENDIF 
    106                ENDIF 
    107             END DO 
    108          END DO 
     100               END DO 
     101            END DO 
     102         ENDDO 
    109103      ENDIF 
    110104 
    111105      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    112106 
    113          ta(:,nlcj,:) = alpha1 * zta(:,nlcj,:) + alpha2 * zta(:,nlcj-1,:) 
    114          sa(:,nlcj,:) = alpha1 * zsa(:,nlcj,:) + alpha2 * zsa(:,nlcj-1,:) 
    115  
    116          DO jk = 1, jpkm1 
    117             DO ji = 1, jpi 
    118                IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
    119                   ta(ji,nlcj-1,jk) = ta(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 
    120                   sa(ji,nlcj-1,jk) = sa(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 
    121                ELSE 
    122                   ta(ji,nlcj-1,jk)=(alpha4*ta(ji,nlcj,jk)+alpha3*ta(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk)         
    123                   sa(ji,nlcj-1,jk)=(alpha4*sa(ji,nlcj,jk)+alpha3*sa(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk) 
    124                   IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
    125                      ta(ji,nlcj-1,jk)=( alpha6*ta(ji,nlcj-2,jk)+alpha5*ta(ji,nlcj,jk)  & 
    126                         &             + alpha7*ta(ji,nlcj-3,jk) ) * tmask(ji,nlcj-1,jk) 
    127                      sa(ji,nlcj-1,jk)=( alpha6*sa(ji,nlcj-2,jk)+alpha5*sa(ji,nlcj,jk)  & 
    128                         &             + alpha7*sa(ji,nlcj-3,jk))*tmask(ji,nlcj-1,jk) 
     107         DO jn = 1, jpts 
     108            tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn) 
     109            DO jk = 1, jpkm1 
     110               DO ji = 1, jpi 
     111                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     112                     tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     113                  ELSE 
     114                     tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     115                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     116                        tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  & 
     117                           &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     118                     ENDIF 
    129119                  ENDIF 
    130                ENDIF 
    131             END DO 
    132          END DO 
     120               END DO 
     121            END DO 
     122         ENDDO  
    133123      ENDIF 
    134124 
    135125      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    136          ta(1,:,:) = alpha1 * zta(1,:,:) + alpha2 * zta(2,:,:) 
    137          sa(1,:,:) = alpha1 * zsa(1,:,:) + alpha2 * zsa(2,:,:)       
    138          DO jk = 1, jpkm1 
    139             DO jj = 1, jpj 
    140                IF( umask(2,jj,jk) == 0.e0 ) THEN 
    141                   ta(2,jj,jk) = ta(1,jj,jk) * tmask(2,jj,jk) 
    142                   sa(2,jj,jk) = sa(1,jj,jk) * tmask(2,jj,jk) 
    143                ELSE 
    144                   ta(2,jj,jk)=(alpha4*ta(1,jj,jk)+alpha3*ta(3,jj,jk))*tmask(2,jj,jk)         
    145                   sa(2,jj,jk)=(alpha4*sa(1,jj,jk)+alpha3*sa(3,jj,jk))*tmask(2,jj,jk) 
    146                   IF( un(2,jj,jk) < 0.e0 ) THEN 
    147                      ta(2,jj,jk)=(alpha6*ta(3,jj,jk)+alpha5*ta(1,jj,jk)+alpha7*ta(4,jj,jk))*tmask(2,jj,jk) 
    148                      sa(2,jj,jk)=(alpha6*sa(3,jj,jk)+alpha5*sa(1,jj,jk)+alpha7*sa(4,jj,jk))*tmask(2,jj,jk) 
     126         DO jn = 1, jpts 
     127            tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn) 
     128            DO jk = 1, jpkm1 
     129               DO jj = 1, jpj 
     130                  IF( umask(2,jj,jk) == 0.e0 ) THEN 
     131                     tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
     132                  ELSE 
     133                     tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
     134                     IF( un(2,jj,jk) < 0.e0 ) THEN 
     135                        tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
     136                     ENDIF 
    149137                  ENDIF 
    150                ENDIF 
     138               END DO 
    151139            END DO 
    152140         END DO 
    … …  
    154142 
    155143      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    156          ta(:,1,:) = alpha1 * zta(:,1,:) + alpha2 * zta(:,2,:) 
    157          sa(:,1,:) = alpha1 * zsa(:,1,:) + alpha2 * zsa(:,2,:) 
    158          DO jk=1,jpk       
    159             DO ji=1,jpi 
    160                IF( vmask(ji,2,jk) == 0.e0 ) THEN 
    161                   ta(ji,2,jk)=ta(ji,1,jk) * tmask(ji,2,jk) 
    162                   sa(ji,2,jk)=sa(ji,1,jk) * tmask(ji,2,jk) 
    163                ELSE 
    164                   ta(ji,2,jk)=(alpha4*ta(ji,1,jk)+alpha3*ta(ji,3,jk))*tmask(ji,2,jk) 
    165                   sa(ji,2,jk)=(alpha4*sa(ji,1,jk)+alpha3*sa(ji,3,jk))*tmask(ji,2,jk)  
    166                   IF( vn(ji,2,jk) < 0.e0 ) THEN 
    167                      ta(ji,2,jk)=(alpha6*ta(ji,3,jk)+alpha5*ta(ji,1,jk)+alpha7*ta(ji,4,jk))*tmask(ji,2,jk) 
    168                      sa(ji,2,jk)=(alpha6*sa(ji,3,jk)+alpha5*sa(ji,1,jk)+alpha7*sa(ji,4,jk))*tmask(ji,2,jk) 
     144         DO jn = 1, jpts 
     145            tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn) 
     146            DO jk=1,jpk       
     147               DO ji=1,jpi 
     148                  IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     149                     tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
     150                  ELSE 
     151                     tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
     152                     IF( vn(ji,2,jk) < 0.e0 ) THEN 
     153                        tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
     154                     ENDIF 
    169155                  ENDIF 
    170                ENDIF 
    171             END DO 
    172          END DO 
     156               END DO 
     157            END DO 
     158         ENDDO 
    173159      ENDIF 
    174160      ! 
    175       IF( wrk_not_released(3, 1,2) ) THEN 
     161      IF( wrk_not_released(4, 1) ) THEN 
    176162         CALL ctl_stop('agrif_tra: failed to release workspace arrays.') 
    177163      ENDIF 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r2715 r2977  
    1212   PRIVATE 
    1313 
    14    PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptn, interpsn, interpun, interpvn 
     14   PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
    1515 
    1616   !!---------------------------------------------------------------------- 
    … …  
    2828#include "domzgr_substitute.h90" 
    2929      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    30       USE wrk_nemo, ONLY: wrk_2d_1 
    31       USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
    32       USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4 
    33       USE wrk_nemo, ONLY: wrk_3d_7, wrk_3d_6 
    34       USE wrk_nemo, ONLY: wrk_3d_8 
     30      USE wrk_nemo, ONLY: wrk_2d_1, wrk_2d_2, wrk_2d_3 
     31      USE wrk_nemo, ONLY: wrk_4d_1, wrk_4d_2 
    3532      !! 
    36       INTEGER :: ji,jj,jk 
     33      INTEGER :: ji,jj,jk,jn 
    3734      INTEGER :: spongearea 
    3835      REAL(wp) :: timecoeff 
    39       REAL(wp) :: zta, zsa, zabe1, zabe2, zbtr 
    40       REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
    41       REAL(wp), POINTER, DIMENSION(:,:,:) :: tbdiff, sbdiff 
    42       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, zsu, ztv, zsv 
    43       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
     36      REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
     37      REAL(wp), POINTER, DIMENSION(:,:    ) :: localviscsponge 
     38      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv 
     39      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
     40      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff 
    4441 
    4542#if defined SPONGE 
    4643      localviscsponge => wrk_2d_1 
    47       tbdiff => wrk_3d_1 ;sbdiff => wrk_3d_2 
    48       ztu => wrk_3d_3 ; zsu => wrk_3d_4 
    49       ztv => wrk_3d_7 ; zsv => wrk_3d_6 
    50       ztab => wrk_3d_8 
     44      ztu             => wrk_2d_2 
     45      ztv             => wrk_2d_3 
     46      ztab            => wrk_4d_1 
     47      tsbdiff         => wrk_4d_2 
    5148 
    5249      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    5552      Agrif_UseSpecialValue = .TRUE. 
    5653      ztab = 0.e0 
    57       CALL Agrif_Bc_Variable(ztab, ta_id,calledweight=timecoeff,procname=interptn) 
     54      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn) 
    5855      Agrif_UseSpecialValue = .FALSE. 
    5956 
    60       tbdiff(:,:,:) = tb(:,:,:) - ztab(:,:,:) 
    61  
    62       ztab = 0.e0 
    63       Agrif_SpecialValue=0. 
    64       Agrif_UseSpecialValue = .TRUE. 
    65       CALL Agrif_Bc_Variable(ztab, sa_id,calledweight=timecoeff,procname=interpsn) 
    66       Agrif_UseSpecialValue = .FALSE. 
    67  
    68       sbdiff(:,:,:) = sb(:,:,:) - ztab(:,:,:) 
     57      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 
    6958 
    7059      spongearea = 2 + 2 * Agrif_irhox() 
    … …  
    137126      ENDIF 
    138127 
    139       DO jk = 1, jpkm1 
    140          DO jj = 1, jpjm1 
    141             DO ji = 1, jpim1 
    142                zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
    143                zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
    144                ztu(ji,jj,jk) = zabe1 * ( tbdiff(ji+1,jj  ,jk) - tbdiff(ji,jj,jk) ) 
    145                zsu(ji,jj,jk) = zabe1 * ( sbdiff(ji+1,jj  ,jk) - sbdiff(ji,jj,jk) ) 
    146                ztv(ji,jj,jk) = zabe2 * ( tbdiff(ji  ,jj+1,jk) - tbdiff(ji,jj,jk) ) 
    147                zsv(ji,jj,jk) = zabe2 * ( sbdiff(ji  ,jj+1,jk) - sbdiff(ji,jj,jk) ) 
     128      DO jn = 1, jpts 
     129         DO jk = 1, jpkm1 
     130            ! 
     131            DO jj = 1, jpjm1 
     132               DO ji = 1, jpim1 
     133                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
     134                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
     135                  ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     136                  ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     137               ENDDO 
    148138            ENDDO 
    149          ENDDO 
    150  
    151          DO jj = 2,jpjm1 
    152             DO ji = 2,jpim1 
    153                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    154                ! horizontal diffusive trends 
    155                zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
    156                   &          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    157                zsa = zbtr * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)   & 
    158                   &          + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) 
    159                ! add it to the general tracer trends 
    160                ta(ji,jj,jk) = (ta(ji,jj,jk) + zta) 
    161                sa(ji,jj,jk) = (sa(ji,jj,jk) + zsa) 
     139 
     140            DO jj = 2, jpjm1 
     141               DO ji = 2, jpim1 
     142                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
     143                  ! horizontal diffusive trends 
     144                  ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   & 
     145                  &              + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
     146                  ! add it to the general tracer trends 
     147                  tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
     148               END DO 
    162149            END DO 
    163          END DO 
    164  
     150            ! 
     151         ENDDO 
    165152      ENDDO 
    166153 
    … …  
    345332   END SUBROUTINE Agrif_Sponge_dyn 
    346333 
    347    SUBROUTINE interptn(tabres,i1,i2,j1,j2,k1,k2) 
    348       !!--------------------------------------------- 
    349       !!   *** ROUTINE interptn *** 
     334   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
     335      !!--------------------------------------------- 
     336      !!   *** ROUTINE interptsn *** 
    350337      !!--------------------------------------------- 
    351338#  include "domzgr_substitute.h90"        
    352339       
    353       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    354       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    355  
    356       tabres(i1:i2,j1:j2,k1:k2) = tn(i1:i2,j1:j2,k1:k2) 
    357  
    358    END SUBROUTINE interptn 
    359  
    360    SUBROUTINE interpsn(tabres,i1,i2,j1,j2,k1,k2) 
    361       !!--------------------------------------------- 
    362       !!   *** ROUTINE interpsn *** 
    363       !!--------------------------------------------- 
    364 #  include "domzgr_substitute.h90"        
    365        
    366       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    367       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    368  
    369       tabres(i1:i2,j1:j2,k1:k2) = sn(i1:i2,j1:j2,k1:k2) 
    370  
    371    END SUBROUTINE interpsn 
     340      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     341      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     342 
     343      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     344 
     345   END SUBROUTINE interptsn 
    372346 
    373347   SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r2715 r2977  
    3030      !!--------------------------------------------- 
    3131      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    32       USE wrk_nemo, ONLY: wrk_3d_1 
     32      USE wrk_nemo, ONLY: wrk_4d_1 
    3333      !! 
    3434      INTEGER, INTENT(in) :: kt 
    35       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
     35      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    3636 
    3737        
    3838      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    3939#if defined TWO_WAY 
    40       ztab => wrk_3d_1 
    41       IF( wrk_in_use(3, 1) ) THEN 
     40      IF( wrk_in_use(4, 1) ) THEN 
    4241         CALL ctl_stop('agrif_update_tra: ERROR: requested workspace arrays unavailable') 
    4342         RETURN 
    4443      END IF 
     44      ztab => wrk_4d_1 
    4545 
    4646      Agrif_UseSpecialValueInUpdate = .TRUE. 
    … …  
    4848 
    4949      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
    50          CALL Agrif_Update_Variable(ztab,tn_id, procname=updateT) 
    51          CALL Agrif_Update_Variable(ztab,sn_id, procname=updateS) 
    52       ELSE 
    53          CALL Agrif_Update_Variable(ztab,tn_id,locupdate=(/0,2/), procname=updateT) 
    54          CALL Agrif_Update_Variable(ztab,sn_id,locupdate=(/0,2/), procname=updateS) 
     50         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 
     51      ELSE 
     52         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 
    5553      ENDIF 
    5654 
    5755      Agrif_UseSpecialValueInUpdate = .FALSE. 
    5856 
    59       IF( wrk_not_released(3, 1) ) THEN 
     57      IF( wrk_not_released(4, 1) ) THEN 
    6058         CALL ctl_stop('Agrif_Update_Tra: ERROR: failed to release workspace arrays') 
    6159      END IF 
    … …  
    124122   END SUBROUTINE recompute_diags 
    125123 
    126    SUBROUTINE updateT( tabres, i1, i2, j1, j2, k1, k2, before ) 
     124   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    127125      !!--------------------------------------------- 
    128126      !!           *** ROUTINE updateT *** 
    … …  
    130128#  include "domzgr_substitute.h90" 
    131129 
    132       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    133       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     130      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     131      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    134132      LOGICAL, iNTENT(in) :: before 
    135133 
    136       INTEGER :: ji,jj,jk 
    137  
    138       IF (before) THEN 
    139          DO jk=k1,k2 
    140             DO jj=j1,j2 
    141                DO ji=i1,i2 
    142                   tabres(ji,jj,jk) = tn(ji,jj,jk) 
    143                END DO 
    144             END DO 
    145          END DO 
    146       ELSE 
    147          DO jk=k1,k2 
    148             DO jj=j1,j2 
    149                DO ji=i1,i2 
    150                   IF( tabres(ji,jj,jk) .NE. 0. ) THEN 
    151                      tn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk) 
    152                   ENDIF 
    153                END DO 
    154             END DO 
    155          END DO 
    156       ENDIF 
    157  
    158    END SUBROUTINE updateT 
    159  
    160    SUBROUTINE updateS( tabres, i1, i2, j1, j2, k1, k2, before ) 
    161       !!--------------------------------------------- 
    162       !!           *** ROUTINE updateS *** 
    163       !!--------------------------------------------- 
    164 #  include "domzgr_substitute.h90" 
    165  
    166       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    167       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    168       LOGICAL, iNTENT(in) :: before 
    169  
    170       INTEGER :: ji,jj,jk 
    171  
    172       IF (before) THEN 
    173          DO jk=k1,k2 
    174             DO jj=j1,j2 
    175                DO ji=i1,i2 
    176                   tabres(ji,jj,jk) = sn(ji,jj,jk) 
    177                END DO 
    178             END DO 
    179          END DO 
    180       ELSE 
    181          DO jk=k1,k2 
    182             DO jj=j1,j2 
    183                DO ji=i1,i2 
    184                   IF (tabres(ji,jj,jk).NE.0.) THEN 
    185                      sn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk) 
    186                   ENDIF 
    187                END DO 
    188             END DO 
    189          END DO 
    190       ENDIF 
    191  
    192    END SUBROUTINE updateS 
     134      INTEGER :: ji,jj,jk,jn 
     135 
     136      IF (before) THEN 
     137         DO jn = n1,n2 
     138            DO jk=k1,k2 
     139               DO jj=j1,j2 
     140                  DO ji=i1,i2 
     141                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 
     142                  END DO 
     143               END DO 
     144            END DO 
     145         END DO 
     146      ELSE 
     147         DO jn = n1,n2 
     148            DO jk=k1,k2 
     149               DO jj=j1,j2 
     150                  DO ji=i1,i2 
     151                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN  
     152                         tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     153                     END IF 
     154                  END DO 
     155               END DO 
     156            END DO 
     157         END DO 
     158      ENDIF 
     159 
     160   END SUBROUTINE updateTS 
    193161 
    194162   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r2727 r2977  
    5454      USE dom_oce 
    5555      USE nemogcm 
    56 #if defined key_tradmp   ||   defined key_esopa 
    5756      USE tradmp 
    58 #endif 
    5957#if defined key_obc   ||   defined key_esopa 
    6058      USE obc_par 
    … …  
    7169 
    7270      ! Specific fine grid Initializations 
    73 #if defined key_tradmp || defined key_esopa 
    7471      ! no tracer damping on fine grids 
    75       lk_tradmp = .FALSE. 
    76 #endif 
     72      ln_tradmp = .FALSE. 
    7773#if defined key_obc || defined key_esopa 
    7874      ! no open boundary on fine grids 
    … …  
    110106      IMPLICIT NONE 
    111107      ! 
    112       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp 
     108      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
     109      REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
    113110      LOGICAL :: check_namelist 
    114111      !!---------------------------------------------------------------------- 
    115112 
    116       ALLOCATE( tabtemp(jpi,jpj,jpk) ) 
    117        
    118        
     113      ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
     114      ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
     115 
     116 
    119117      ! 1. Declaration of the type of variable which have to be interpolated 
    120118      !--------------------------------------------------------------------- 
    … …  
    125123      Agrif_SpecialValue=0. 
    126124      Agrif_UseSpecialValue = .TRUE. 
    127       Call Agrif_Bc_variable(tabtemp,tn_id,calledweight=1.,procname=interptn) 
    128      
    129       Call Agrif_Bc_variable(tabtemp,sn_id,calledweight=1.,procname=interpsn) 
    130       Call Agrif_Bc_variable(tabtemp,un_id,calledweight=1.,procname=interpu) 
    131       Call Agrif_Bc_variable(tabtemp,vn_id,calledweight=1.,procname=interpv) 
    132  
    133       Call Agrif_Bc_variable(tabtemp,ta_id,calledweight=1.,procname=interptn) 
    134       Call Agrif_Bc_variable(tabtemp,sa_id,calledweight=1.,procname=interpsn) 
    135  
    136       Call Agrif_Bc_variable(tabtemp,ua_id,calledweight=1.,procname=interpun) 
    137       Call Agrif_Bc_variable(tabtemp,va_id,calledweight=1.,procname=interpvn) 
     125      Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
     126      Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
     127 
     128      Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
     129      Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
     130      Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
     131      Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
    138132      Agrif_UseSpecialValue = .FALSE. 
    139133 
    … …  
    192186      nbcline = 0 
    193187      ! 
    194       DEALLOCATE(tabtemp) 
     188      DEALLOCATE(tabtstemp) 
     189      DEALLOCATE(tabuvtemp) 
    195190      ! 
    196191   END SUBROUTINE Agrif_InitValues_cont 
    … …  
    204199      !!---------------------------------------------------------------------- 
    205200      USE agrif_util 
     201      USE par_oce       !   ONLY : jpts 
    206202      USE oce 
    207203      IMPLICIT NONE 
    … …  
    210206      ! 1. Declaration of the type of variable which have to be interpolated 
    211207      !--------------------------------------------------------------------- 
    212       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tn_id) 
    213       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sn_id) 
    214       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tb_id) 
    215       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sb_id) 
    216       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ta_id) 
    217       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sa_id) 
    218           
     208      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     209      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
     210      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
     211 
    219212      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
    220213      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
    … …  
    230223      ! 2. Type of interpolation 
    231224      !------------------------- 
    232       CALL Agrif_Set_bcinterp(tn_id,interp=AGRIF_linear) 
    233       CALL Agrif_Set_bcinterp(sn_id,interp=AGRIF_linear) 
    234       CALL Agrif_Set_bcinterp(ta_id,interp=AGRIF_linear) 
    235       CALL Agrif_Set_bcinterp(sa_id,interp=AGRIF_linear) 
     225      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
     226      CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
    236227    
    237228      Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    … …  
    252243      Call Agrif_Set_bc(e2v_id,(/0,0/)) 
    253244 
    254       Call Agrif_Set_bc(tn_id,(/0,1/)) 
    255       Call Agrif_Set_bc(sn_id,(/0,1/)) 
    256  
    257       Call Agrif_Set_bc(ta_id,(/-3*Agrif_irhox(),0/)) 
    258       Call Agrif_Set_bc(sa_id,(/-3*Agrif_irhox(),0/)) 
     245      Call Agrif_Set_bc(tsn_id,(/0,1/)) 
     246      Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
    259247 
    260248      Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
    … …  
    263251      ! 5. Update type 
    264252      !---------------  
    265       Call Agrif_Set_Updatetype(tn_id, update = AGRIF_Update_Average) 
    266       Call Agrif_Set_Updatetype(sn_id, update = AGRIF_Update_Average) 
    267  
    268       Call Agrif_Set_Updatetype(tb_id, update = AGRIF_Update_Average) 
    269       Call Agrif_Set_Updatetype(sb_id, update = AGRIF_Update_Average) 
     253      Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     254      Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
    270255 
    271256      Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    … …  
    395380      ! 1. Declaration of the type of variable which have to be interpolated 
    396381      !--------------------------------------------------------------------- 
    397       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
    398       &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    399       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
    400       &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
    401       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0,jptra/),(/'x','y','N','N'/),  & 
    402       &                           (/1,1,1,1/),(/jpi,jpj,jpk/),tra_id) 
    403              
     382      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     383      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
     384      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
    404385#  if defined key_offline 
    405386      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OFF_SRC/dommsk.F90

    r2715 r2977  
    1919 
    2020   PUBLIC   dom_msk    ! routine called by inidom.F90 
    21  
    22    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   facvol   !: volume for degraded regions 
    2321 
    2422   !! * Substitutions 
    … …  
    5654      END IF 
    5755      ! 
    58 #if defined key_degrad 
    59       IF( dom_msk_alloc() /= 0 )   CALL ctl_stop('STOP','dom_msk: unable to allocate arrays') 
    60 #endif 
    61  
    6256      ! Interior domain mask (used for global sum) 
    6357      ! -------------------- 
    … …  
    10498      ! 
    10599   END SUBROUTINE dom_msk 
    106  
    107  
    108    INTEGER FUNCTION dom_msk_alloc() 
    109       !!--------------------------------------------------------------------- 
    110       !!                 ***  FUNCTION dom_msk_alloc  *** 
    111       !!--------------------------------------------------------------------- 
    112       ALLOCATE( facvol(jpi,jpj,jpk) , STAT=dom_msk_alloc ) 
    113       IF( dom_msk_alloc /= 0 )   CALL ctl_warn('dom_msk_alloc : failed to allocate facvol array') 
    114       ! 
    115    END FUNCTION dom_msk_alloc 
    116  
    117100   !!====================================================================== 
    118101END MODULE dommsk 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r2787 r2977  
    1616   USE dommsk          ! domain: masks 
    1717   USE lbclnk          ! lateral boundary condition - MPP exchanges 
     18   USE trc_oce         ! shared ocean/biogeochemical variables 
    1819   USE lib_mpp  
    1920   USE in_out_manager 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r2764 r2977  
    1111   !!              -   ! 2005-12 (C. Ethe) Adapted for DEGINT 
    1212   !!             3.0  ! 2007-06 (C. Ethe) use of iom module 
    13    !!              -   ! 2007-09  (C. Ethe)  add swap_dyn_data 
    1413   !!             3.3  ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line 
     14   !!             3.4  ! 2011-05 (C. Ethe) Use of fldread 
    1515   !!---------------------------------------------------------------------- 
    1616 
    1717   !!---------------------------------------------------------------------- 
    18    !!   dta_dyn_init : initialization, namelist read, and parameters control 
     18   !!   dta_dyn_init : initialization, namelist read, and SAVEs control 
    1919   !!   dta_dyn      : Interpolation of the fields 
    2020   !!---------------------------------------------------------------------- 
    … …  
    2424   USE zdf_oce         ! ocean vertical physics: variables 
    2525   USE sbc_oce         ! surface module: variables 
     26   USE trc_oce         ! share ocean/biogeo variables 
    2627   USE phycst          ! physical constants 
    2728   USE trabbl          ! active tracer: bottom boundary layer 
    … …  
    3637   USE iom             ! I/O library 
    3738   USE lib_mpp         ! distributed memory computing library 
    38    USE prtctl          !  print control 
     39   USE prtctl          ! print control 
     40   USE fldread         ! read input fields  
    3941 
    4042   IMPLICIT NONE 
    … …  
    4446   PUBLIC   dta_dyn        ! called by step.F90 
    4547 
    46    LOGICAL, PUBLIC ::   lperdyn = .TRUE.   !: boolean for periodic fields or not 
    47    LOGICAL, PUBLIC ::   lfirdyn = .TRUE.   !: boolean for the first call or not 
    48  
    49    INTEGER, PUBLIC ::   ndtadyn = 73       !: Number of dat in one year 
    50    INTEGER, PUBLIC ::   ndtatot = 73       !: Number of data in the input field 
    51    INTEGER, PUBLIC ::   nsptint = 1        !: type of spatial interpolation 
    52  
    53    CHARACTER(len=45) ::   cfile_grid_T = 'dyna_grid_T.nc'   ! name of the grid_T file 
    54    CHARACTER(len=45) ::   cfile_grid_U = 'dyna_grid_U.nc'   ! name of the grid_U file 
    55    CHARACTER(len=45) ::   cfile_grid_V = 'dyna_grid_V.nc'   ! name of the grid_V file 
    56    CHARACTER(len=45) ::   cfile_grid_W = 'dyna_grid_W.nc'   ! name of the grid_W file 
    57     
    58    REAL(wp) ::   rnspdta    ! number of time step per 2 consecutives data 
    59    REAL(wp) ::   rnspdta2   ! rnspdta * 0.5 
    60  
    61    INTEGER ::   ndyn1, ndyn2    ! 
    62    INTEGER ::   nlecoff = 0     ! switch for the first read 
    63    INTEGER ::   numfl_t, numfl_u, numfl_v, numfl_w 
    64  
    65    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tdta       ! temperature at two consecutive times 
    66    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sdta       ! salinity at two consecutive times 
    67    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: udta       ! zonal velocity at two consecutive times 
    68    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vdta       ! meridional velocity at two consecutive times 
    69    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta       ! vertical velocity at two consecutive times 
    70    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: avtdta     ! vertical diffusivity coefficient 
    71  
    72    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: hmlddta    ! mixed layer depth at two consecutive times 
    73    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: wspddta    ! wind speed at two consecutive times 
    74    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: frlddta    ! sea-ice fraction at two consecutive times 
    75    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: empdta     ! E-P at two consecutive times 
    76    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: qsrdta     ! short wave heat flux at two consecutive times 
    77    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: bblxdta    ! bbl diffusive coef. in the x direction at 2 consecutive times  
    78    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: bblydta    ! bbl diffusive coef. in the y direction at 2 consecutive times  
    79    LOGICAL :: l_offbbl 
    80 #if defined key_ldfslp && ! defined key_c1d 
    81    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta    ! zonal isopycnal slopes 
    82    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta    ! meridional isopycnal slopes 
    83    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta   ! zonal diapycnal slopes 
    84    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta   ! meridional diapycnal slopes 
    85 #endif 
    86 #if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv  
    87    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: aeiwdta    ! G&M coefficient 
    88 #endif 
    89 #if defined key_degrad 
    90    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ahtudta, ahtvdta, ahtwdta   ! Lateral diffusivity 
    91 # if defined key_traldf_eiv 
    92    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: aeiudta, aeivdta, aeiwdta   ! G&M coefficient 
    93 # endif 
    94 #endif 
     48   CHARACTER(len=100) ::   cn_dir     = './'    !: Root directory for location of ssr files 
     49   LOGICAL            ::   ln_dynwzv  = .true.  !: vertical velocity read in a file (T) or computed from u/v (F) 
     50   LOGICAL            ::   ln_dynbbl  = .true.  !: bbl coef read in a file (T) or computed (F) 
     51   LOGICAL            ::   ln_degrad  = .false. !: degradation option enabled or not  
     52 
     53   INTEGER  , PARAMETER ::   jpfld = 19     ! maximum number of files to read 
     54   INTEGER  , SAVE      ::   jf_tem         ! index of temperature 
     55   INTEGER  , SAVE      ::   jf_sal         ! index of salinity 
     56   INTEGER  , SAVE      ::   jf_uwd         ! index of u-wind 
     57   INTEGER  , SAVE      ::   jf_vwd         ! index of v-wind 
     58   INTEGER  , SAVE      ::   jf_wwd         ! index of w-wind 
     59   INTEGER  , SAVE      ::   jf_avt         ! index of Kz 
     60   INTEGER  , SAVE      ::   jf_mld         ! index of mixed layer deptht 
     61   INTEGER  , SAVE      ::   jf_emp         ! index of water flux 
     62   INTEGER  , SAVE      ::   jf_qsr         ! index of solar radiation 
     63   INTEGER  , SAVE      ::   jf_wnd         ! index of wind speed 
     64   INTEGER  , SAVE      ::   jf_ice         ! index of sea ice cover 
     65   INTEGER  , SAVE      ::   jf_ubl         ! index of u-bbl coef 
     66   INTEGER  , SAVE      ::   jf_vbl         ! index of v-bbl coef 
     67   INTEGER  , SAVE      ::   jf_ahu         ! index of u-diffusivity coef 
     68   INTEGER  , SAVE      ::   jf_ahv         ! index of v-diffusivity coef  
     69   INTEGER  , SAVE      ::   jf_ahw         ! index of w-diffusivity coef 
     70   INTEGER  , SAVE      ::   jf_eiu         ! index of u-eiv 
     71   INTEGER  , SAVE      ::   jf_eiv         ! index of v-eiv 
     72   INTEGER  , SAVE      ::   jf_eiw         ! index of w-eiv 
     73 
     74   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn  ! structure of input fields (file informations, fields read) 
     75   !                                               !  
     76   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta       ! vertical velocity at 2 time step 
     77   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) :: wnow       ! vertical velocity at 2 time step 
     78   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta    ! zonal isopycnal slopes 
     79   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta    ! meridional isopycnal slopes 
     80   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta   ! zonal diapycnal slopes 
     81   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta   ! meridional diapycnal slopes 
     82   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: uslpnow    ! zonal isopycnal slopes 
     83   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: vslpnow    ! meridional isopycnal slopes 
     84   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: wslpinow   ! zonal diapycnal slopes 
     85   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: wslpjnow   ! meridional diapycnal slopes 
     86 
     87   INTEGER :: nrecprev_tem , nrecprev_uwd 
    9588 
    9689   !! * Substitutions 
    … …  
    108101      !!                  ***  ROUTINE dta_dyn  *** 
    109102      !! 
    110       !! ** Purpose :   Prepares dynamics and physics fields from an NEMO run 
    111       !!              for an off-line simulation of passive tracers 
    112       !! 
    113       !! ** Method : calculates the position of DATA to read READ DATA  
    114       !!             (example month changement) computes slopes IF needed 
    115       !!             interpolates DATA IF needed 
    116       !!---------------------------------------------------------------------- 
     103      !! ** Purpose :  Prepares dynamics and physics fields from a NEMO run 
     104      !!               for an off-line simulation of passive tracers 
     105      !! 
     106      !! ** Method : calculates the position of data  
     107      !!             - computes slopes if needed 
     108      !!             - interpolates data if needed 
     109      !!---------------------------------------------------------------------- 
     110      ! 
     111      USE oce, ONLY:  zts    => tsa  
     112      USE oce, ONLY:  zuslp  => ua   , zvslp  => va 
     113      USE oce, ONLY:  zwslpi => rotb , zwslpj => rotn 
     114      USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => hdivb 
     115      ! 
    117116      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    118       !! 
    119       INTEGER  ::   iper, iperm1, iswap, izt   ! local integers  
    120       REAL(wp) ::   zt, zweigh                 ! local scalars 
    121       !!---------------------------------------------------------------------- 
    122  
    123       zt     = ( REAL(kt,wp) + rnspdta2 ) / rnspdta 
    124       izt    = INT( zt ) 
    125       zweigh = zt - REAL( INT(zt), wp ) 
    126  
    127       IF( lperdyn ) THEN   ;   iperm1 = MOD( izt, ndtadyn ) 
    128       ELSE                 ;   iperm1 = MOD( izt, ndtatot - 1 ) + 1 
    129       ENDIF 
    130  
    131       iper = iperm1 + 1 
    132       IF( iperm1 == 0 ) THEN 
    133           IF( lperdyn ) THEN 
    134               iperm1 = ndtadyn 
    135           ELSE  
    136               IF( lfirdyn ) THEN  
    137                   IF(lwp) WRITE (numout,*) 'dta_dyn:  dynamic file is not periodic with or without interpolation    & 
    138                      &                                we take the first value for the previous period iperm1 = 0  ' 
    139               END IF 
    140           END IF  
    141       END IF  
    142  
    143       iswap  = 0 
    144  
    145       ! 1. First call lfirdyn = true 
    146       ! ---------------------------- 
    147  
    148       IF( lfirdyn ) THEN 
    149          ndyn1 = iperm1         ! store the information of the period read 
    150          ndyn2 = iper 
    151           
    152          IF(lwp) THEN 
    153             WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,   & 
    154                &             ' and for the period ndyn2 = ', ndyn2 
    155             WRITE (numout,*) ' time step is : ', kt 
    156             WRITE (numout,*) ' we have ndtadyn = ', ndtadyn, ' records in the dynamic file for one year' 
    157          END IF 
     117      ! 
     118      INTEGER  ::   ji, jj     ! dummy loop indices 
     119      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
     120      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
     121      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
     122      INTEGER  ::   iswap_tem, iswap_uwd    !  
     123      !!---------------------------------------------------------------------- 
     124       
     125      isecsbc = nsec_year + nsec1jan000  
     126      ! 
     127      IF( kt == nit000 ) THEN 
     128         nrecprev_tem = 0 
     129         nrecprev_uwd = 0 
    158130         ! 
    159          CALL dynrea( kt, MAX( 1, iperm1) )           ! data read for the iperm1 period 
     131         CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==! 
    160132         ! 
    161          CALL swap_dyn_data            ! swap from record 2 to 1 
     133         IF( lk_ldfslp .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                        
     134            zts(:,:,:,jf_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature 
     135            zts(:,:,:,jf_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity  
     136            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef. 
     137            CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     138            uslpdta (:,:,:,1) = zuslp (:,:,:)  
     139            vslpdta (:,:,:,1) = zvslp (:,:,:)  
     140            wslpidta(:,:,:,1) = zwslpi(:,:,:)  
     141            wslpjdta(:,:,:,1) = zwslpj(:,:,:)  
     142         ENDIF 
     143         IF( ln_dynwzv .AND. sf_dyn(jf_uwd)%ln_tint )  THEN    ! compute vertical velocity from u/v 
     144            zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,1) 
     145            zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,1) 
     146            CALL dta_dyn_wzv( zu, zv, zw ) 
     147            wdta(:,:,:,1) = zw(:,:,:) * tmask(:,:,:) 
     148         ENDIF 
     149      ELSE 
     150         nrecprev_tem = sf_dyn(jf_tem)%nrec_a(2) 
     151         nrecprev_uwd = sf_dyn(jf_uwd)%nrec_a(2) 
    162152         ! 
    163          iswap = 1        !  indicates swap 
     153         CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==! 
    164154         ! 
    165          CALL dynrea( kt, iper )       ! data read for the iper period 
    166          ! 
    167          lfirdyn = .FALSE.    ! trace the first call 
    168       ENDIF 
    169       ! 
    170       ! And now what we have to do at every time step 
    171       ! check the validity of the period in memory 
    172       ! 
    173       IF( iperm1 /= ndyn1 ) THEN  
    174          ! 
    175          IF( iperm1 == 0 ) THEN 
    176             IF(lwp) THEN 
    177                WRITE (numout,*) ' dynamic file is not periodic with periodic interpolation' 
    178                WRITE (numout,*) ' we take the last value for the last period ' 
    179                WRITE (numout,*) ' iperm1 = 12,   iper = 13  ' 
     155      ENDIF 
     156      !  
     157      IF( lk_ldfslp ) THEN    ! Computes slopes (here avt is used as workspace)                        
     158         iswap_tem = 0 
     159         IF(  kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 )  iswap_tem = 1 
     160         IF( ( isecsbc > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap_tem == 1 ) .OR. kt == nit000 )  THEN    ! read/update the after data 
     161            write(numout,*) 
     162            write(numout,*) ' Compute new slopes at kt = ', kt 
     163            IF( sf_dyn(jf_tem)%ln_tint ) THEN                 ! time interpolation of data 
     164               IF( kt /= nit000 ) THEN 
     165                  uslpdta (:,:,:,1) =  uslpdta (:,:,:,2)         ! swap the data 
     166                  vslpdta (:,:,:,1) =  vslpdta (:,:,:,2)   
     167                  wslpidta(:,:,:,1) =  wslpidta(:,:,:,2)  
     168                  wslpjdta(:,:,:,1) =  wslpjdta(:,:,:,2)  
     169               ENDIF 
     170               ! 
     171               zts(:,:,:,jf_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
     172               zts(:,:,:,jf_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
     173               avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
     174               CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     175               ! 
     176               uslpdta (:,:,:,2) = zuslp (:,:,:)  
     177               vslpdta (:,:,:,2) = zvslp (:,:,:)  
     178               wslpidta(:,:,:,2) = zwslpi(:,:,:)  
     179               wslpjdta(:,:,:,2) = zwslpj(:,:,:)  
     180            ELSE 
     181               zts(:,:,:,jf_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) 
     182               zts(:,:,:,jf_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) 
     183               avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) 
     184               CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     185               uslpnow (:,:,:)   = zuslp (:,:,:)  
     186               vslpnow (:,:,:)   = zvslp (:,:,:)  
     187               wslpinow(:,:,:)   = zwslpi(:,:,:)  
     188               wslpjnow(:,:,:)   = zwslpj(:,:,:)  
    180189            ENDIF 
    181             iperm1 = 12 
    182             iper   = 13 
    183          ENDIF 
    184          ! 
    185          CALL swap_dyn_data         ! We have to prepare a new read of data : swap from record 2 to 1 
    186          ! 
    187          iswap = 1                  !  indicates swap 
    188          ! 
    189          CALL dynrea( kt, iper )    ! data read for the iper period 
    190          ! 
    191          ndyn1 = ndyn2         ! store the information of the period read 
    192          ndyn2 = iper 
    193          ! 
    194          IF(lwp) THEN 
    195             WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,   & 
    196                &             ' and for the period ndyn2 = ', ndyn2 
    197             WRITE (numout,*) ' time step is : ', kt 
    198          END IF 
    199          ! 
    200       END IF 
    201       ! 
    202       ! Compute the data at the given time step 
    203       !----------------------------------------      
    204  
    205       IF( nsptint == 0 ) THEN          ! No space interpolation, data are probably correct 
    206          !                             ! We have to initialize data if we have changed the period          
    207          CALL assign_dyn_data 
    208       ELSEIF( nsptint == 1 ) THEN      ! linear interpolation 
    209          CALL linear_interp_dyn_data( zweigh ) 
    210       ELSE                             ! other interpolation 
    211          WRITE (numout,*) ' this kind of interpolation do not exist at the moment : we stop' 
    212          STOP 'dtadyn'          
    213       END IF 
    214       ! 
    215       CALL eos( tsn, rhd, rhop )       ! In any case, we need rhop 
    216       ! 
    217 #if ! defined key_degrad && defined key_traldf_c2d 
    218       !                                ! In case of 2D varying coefficients, we need aeiv and aeiu 
    219       IF( lk_traldf_eiv )   CALL dta_eiv( kt )      ! eddy induced velocity coefficient 
    220 #endif 
    221       ! 
    222       IF( .NOT. l_offbbl ) THEN       ! Compute bbl coefficients if needed 
     190         ENDIF 
     191         IF( sf_dyn(jf_tem)%ln_tint )  THEN 
     192            ztinta =  REAL( isecsbc - sf_dyn(jf_tem)%nrec_b(2), wp )  & 
     193               &    / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp ) 
     194            ztintb =  1. - ztinta 
     195            uslp (:,:,:) = ztintb * uslpdta (:,:,:,1)  + ztinta * uslpdta (:,:,:,2)   
     196            vslp (:,:,:) = ztintb * vslpdta (:,:,:,1)  + ztinta * vslpdta (:,:,:,2)   
     197            wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1)  + ztinta * wslpidta(:,:,:,2)   
     198            wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1)  + ztinta * wslpjdta(:,:,:,2)   
     199         ELSE 
     200            uslp (:,:,:) = uslpnow (:,:,:) 
     201            vslp (:,:,:) = vslpnow (:,:,:) 
     202            wslpi(:,:,:) = wslpinow(:,:,:) 
     203            wslpj(:,:,:) = wslpjnow(:,:,:) 
     204         ENDIF 
     205      ENDIF 
     206      ! 
     207      IF( ln_dynwzv )  THEN    ! compute vertical velocity from u/v 
     208         iswap_uwd = 0 
     209         IF(  kt /= nit000 .AND. ( sf_dyn(jf_uwd)%nrec_a(2) - nrecprev_uwd ) /= 0 )  iswap_uwd = 1 
     210         IF( ( isecsbc > sf_dyn(jf_uwd)%nrec_b(2) .AND. iswap_uwd == 1 ) .OR. kt == nit000 )  THEN    ! read/update the after data 
     211            write(numout,*) 
     212            write(numout,*) ' Compute new vertical velocity at kt = ', kt 
     213            write(numout,*) 
     214            IF( sf_dyn(jf_uwd)%ln_tint ) THEN                 ! time interpolation of data 
     215               IF( kt /= nit000 )  THEN 
     216                  wdta(:,:,:,1) =  wdta(:,:,:,2)     ! swap the data for initialisation 
     217               ENDIF 
     218               zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,2) 
     219               zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,2) 
     220               CALL dta_dyn_wzv( zu, zv, zw ) 
     221               wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 
     222            ELSE 
     223               zu(:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:)  
     224               zv(:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) 
     225               CALL dta_dyn_wzv( zu, zv, zw ) 
     226               wnow(:,:,:)  = zw(:,:,:) * tmask(:,:,:) 
     227            ENDIF 
     228         ENDIF 
     229         IF( sf_dyn(jf_uwd)%ln_tint )  THEN 
     230            ztinta =  REAL( isecsbc - sf_dyn(jf_uwd)%nrec_b(2), wp )  & 
     231               &    / REAL( sf_dyn(jf_uwd)%nrec_a(2) - sf_dyn(jf_uwd)%nrec_b(2), wp ) 
     232            ztintb =  1. - ztinta 
     233            wn(:,:,:) = ztintb * wdta(:,:,:,1)  + ztinta * wdta(:,:,:,2)   
     234         ELSE 
     235            wn(:,:,:) = wnow(:,:,:) 
     236         ENDIF 
     237      ENDIF 
     238      ! 
     239      tsn(:,:,:,jf_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)    ! temperature 
     240      tsn(:,:,:,jf_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)    ! salinity 
     241      ! 
     242      CALL eos( tsn, rhd, rhop )                                       ! In any case, we need rhop 
     243      ! 
     244      avt(:,:,:)       = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)    ! vertical diffusive coefficient  
     245      un (:,:,:)       = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! u-velocity 
     246      vn (:,:,:)       = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! v-velocity  
     247      IF( .NOT.ln_dynwzv ) &                                           ! w-velocity read in file  
     248         wn (:,:,:)    = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)     
     249      hmld(:,:)        = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht 
     250      wndm(:,:)        = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1)    ! wind speed - needed for gas exchange 
     251      emp (:,:)        = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
     252      emps(:,:)        = emp(:,:)  
     253      fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)     ! Sea-ice fraction 
     254      qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation 
     255      !                                                      ! bbl diffusive coef 
     256#if defined key_trabbl 
     257      IF( ln_dynbbl ) THEN                                        ! read in a file 
     258         ahu_bbl(:,:)  = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1) 
     259         ahv_bbl(:,:)  = sf_dyn(jf_vbl)%fnow(:,:,1) * umask(:,:,1) 
     260      ELSE                                                        ! Compute bbl coefficients if needed 
    223261         tsb(:,:,:,:) = tsn(:,:,:,:) 
    224262         CALL bbl( kt, 'TRC') 
    225263      END IF 
    226       ! 
    227       IF(ln_ctl) THEN 
    228          CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
    229          CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     264#endif 
     265#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
     266      aeiw(:,:)        = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1)    ! w-eiv 
     267      !                                                           ! Computes the horizontal values from the vertical value 
     268      DO jj = 2, jpjm1 
     269         DO ji = fs_2, fs_jpim1   ! vector opt. 
     270            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )  ! Average the diffusive coefficient at u- v- points 
     271            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )  ! at u- v- points 
     272         END DO 
     273      END DO 
     274      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition 
     275#endif 
     276       
     277#if defined key_degrad 
     278      !                                          ! degrad option : diffusive and eiv coef are 3D 
     279      ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:) 
     280      ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * umask(:,:,:) 
     281      ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * umask(:,:,:) 
     282#  if defined key_traldf_eiv 
     283      aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:) 
     284      aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * umask(:,:,:) 
     285      aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * umask(:,:,:) 
     286#  endif 
     287#endif 
     288      ! 
     289      IF(ln_ctl) THEN                  ! print control 
     290         CALL prt_ctl(tab3d_1=tsn(:,:,:,jf_tem), clinfo1=' tn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     291         CALL prt_ctl(tab3d_1=tsn(:,:,:,jf_sal), clinfo1=' sn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
    230292         CALL prt_ctl(tab3d_1=un               , clinfo1=' un      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
    231293         CALL prt_ctl(tab3d_1=vn               , clinfo1=' vn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
    … …  
    242304 
    243305 
    244    INTEGER FUNCTION dta_dyn_alloc() 
    245       !!--------------------------------------------------------------------- 
    246       !!                 ***  ROUTINE dta_dyn_alloc  *** 
    247       !!--------------------------------------------------------------------- 
    248  
    249       ALLOCATE( tdta    (jpi,jpj,jpk,2), sdta    (jpi,jpj,jpk,2),    & 
    250          &      udta    (jpi,jpj,jpk,2), vdta    (jpi,jpj,jpk,2),    & 
    251          &      wdta    (jpi,jpj,jpk,2), avtdta  (jpi,jpj,jpk,2),    & 
    252 #if defined key_ldfslp && ! defined key_c1d 
    253          &      uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
    254          &      wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2),    & 
    255 #endif 
    256 #if defined key_degrad 
    257          &      ahtudta (jpi,jpj,jpk,2), ahtvdta (jpi,jpj,jpk,2),    & 
    258          &      ahtwdta (jpi,jpj,jpk,2),                             & 
    259 # if defined key_traldf_eiv 
    260          &      aeiudta (jpi,jpj,jpk,2), aeivdta (jpi,jpj,jpk,2),    & 
    261          &      aeiwdta (jpi,jpj,jpk,2),                             & 
    262 # endif 
    263 #endif 
    264 #if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv 
    265          &      aeiwdta (jpi,jpj,    2),                             & 
    266 #endif 
    267          &      hmlddta (jpi,jpj,    2), wspddta (jpi,jpj,    2),    & 
    268          &      frlddta (jpi,jpj,    2), qsrdta  (jpi,jpj,    2),    & 
    269          &      empdta  (jpi,jpj,    2),                         STAT=dta_dyn_alloc )  
    270          ! 
    271       IF( dta_dyn_alloc /= 0 )   CALL ctl_warn('dta_dyn_alloc: failed to allocate facvol array') 
    272       ! 
    273    END FUNCTION dta_dyn_alloc 
    274  
    275  
    276    SUBROUTINE dynrea( kt, kenr ) 
    277       !!---------------------------------------------------------------------- 
    278       !!                  ***  ROUTINE dynrea  *** 
    279       !! 
    280       !! ** Purpose : READ dynamics fiels from OPA9 netcdf output 
    281       !!  
    282       !! ** Method : READ the kenr records of DATA and store in udta(...,2), ....   
    283       !!---------------------------------------------------------------------- 
    284       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    285       USE wrk_nemo, ONLY: zu      => wrk_3d_3  , zv    => wrk_3d_4 , zw   => wrk_3d_5 
    286       USE wrk_nemo, ONLY: zt      => wrk_3d_6  , zs    => wrk_3d_7 , zavt => wrk_3d_8   
    287       USE wrk_nemo, ONLY: zemp    => wrk_2d_11 , zqsr  => wrk_2d_12, zmld => wrk_2d_13 
    288       USE wrk_nemo, ONLY: zice    => wrk_2d_14 , zwspd => wrk_2d_15  
    289       USE wrk_nemo, ONLY: ztaux   => wrk_2d_16 , ztauy => wrk_2d_17 
    290       USE wrk_nemo, ONLY: zbblx   => wrk_2d_18 , zbbly => wrk_2d_19 
    291       USE wrk_nemo, ONLY: zaeiw2d => wrk_2d_10 
    292       USE wrk_nemo, ONLY: ztsn    => wrk_4d_1 
    293       ! 
    294       INTEGER, INTENT(in) ::   kt, kenr   ! time index 
    295       !! 
    296       INTEGER ::  jkenr 
    297 #if defined key_degrad 
    298       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zahtu, zahtv, zahtw   ! Lateral diffusivity 
    299 # if defined key_traldf_eiv 
    300       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zaeiu, zaeiv, zaeiw   ! G&M coefficient 
    301 # endif 
    302 #endif 
    303       !!---------------------------------------------------------------------- 
    304       !  
    305       IF( wrk_in_use(3, 3,4,5,6,7,8) .OR. & 
    306           wrk_in_use(4, 1)                             .OR. & 
    307           wrk_in_use(2, 10,11,12,13,14,15,16,17,18,19)               ) THEN 
    308          CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable')   ;   RETURN 
    309       ENDIF 
    310  
    311 #if defined key_degrad 
    312       ALLOCATE( zahtu(jpi,jpj,jpk), zahtv(jpi,jpj,jpk), zahtw(jpi,jpj,jpk) )  
    313 # if defined key_traldf_eiv 
    314       ALLOCATE( zaeiu(jpi,jpj,jpk), zaeiv(jpi,jpj,jpk), zaeiw(jpi,jpj,jpk) ) 
    315 # endif 
    316 #endif 
    317        
    318       ! cas d'un fichier non periodique : on utilise deux fois le premier et 
    319       ! le dernier champ temporel 
    320  
    321       jkenr = kenr 
    322  
     306   SUBROUTINE dta_dyn_init 
     307      !!---------------------------------------------------------------------- 
     308      !!                  ***  ROUTINE dta_dyn_init  *** 
     309      !! 
     310      !! ** Purpose :   Initialisation of the dynamical data      
     311      !! ** Method  : - read the data namdta_dyn namelist 
     312      !! 
     313      !! ** Action  : - read parameters 
     314      !!---------------------------------------------------------------------- 
     315      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
     316      INTEGER  :: ifpr                               ! dummy loop indice 
     317      INTEGER  :: jfld                               ! dummy loop arguments 
     318      INTEGER  :: inum, idv, idimv                   ! local integer 
     319      !! 
     320      CHARACTER(len=100)            ::  cn_dir   !   Root directory for location of core files 
     321      TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d    ! array of namelist informations on the fields to read 
     322      TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd  ! informations about the fields to be read 
     323      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl          !   "                                 " 
     324      TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw          !   "                                 " 
     325      ! 
     326      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad,    & 
     327         &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd,  & 
     328         &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl,          & 
     329         &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw 
     330 
     331      !!---------------------------------------------------------------------- 
     332      !                                   ! ============ 
     333      !                                   !   Namelist 
     334      !                                   ! ============ 
     335      ! (NB: frequency positive => hours, negative => months) 
     336      !                !   file      ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   ! 
     337      !                !   name      !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      ! 
     338      sn_tem  = FLD_N( 'dyna_grid_T' ,    120    , 'votemper' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     339      sn_sal  = FLD_N( 'dyna_grid_T' ,    120    , 'vosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     340      sn_mld  = FLD_N( 'dyna_grid_T' ,    120    , 'somixght' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     341      sn_emp  = FLD_N( 'dyna_grid_T' ,    120    , 'sowaflcd' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     342      sn_ice  = FLD_N( 'dyna_grid_T' ,    120    , 'soicecov' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     343      sn_qsr  = FLD_N( 'dyna_grid_T' ,    120    , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     344      sn_wnd  = FLD_N( 'dyna_grid_T' ,    120    , 'sowindsp' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     345      sn_uwd  = FLD_N( 'dyna_grid_U' ,    120    , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     346      sn_vwd  = FLD_N( 'dyna_grid_V' ,    120    , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     347      sn_wwd  = FLD_N( 'dyna_grid_W' ,    120    , 'vovecrtz' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     348      sn_avt  = FLD_N( 'dyna_grid_W' ,    120    , 'votkeavt' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     349      sn_ubl  = FLD_N( 'dyna_grid_U' ,    120    , 'sobblcox' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     350      sn_vbl  = FLD_N( 'dyna_grid_V' ,    120    , 'sobblcoy' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     351      sn_ahu  = FLD_N( 'dyna_grid_U' ,    120    , 'vozoahtu' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     352      sn_ahv  = FLD_N( 'dyna_grid_V' ,    120    , 'vomeahtv' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     353      sn_ahw  = FLD_N( 'dyna_grid_W' ,    120    , 'voveahtz' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     354      sn_eiu  = FLD_N( 'dyna_grid_U' ,    120    , 'vozoaeiu' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     355      sn_eiv  = FLD_N( 'dyna_grid_V' ,    120    , 'vomeaeiv' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     356      sn_eiw  = FLD_N( 'dyna_grid_W' ,    120    , 'voveaeiw' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     357      ! 
     358      REWIND( numnam )                          ! read in namlist namdta_dyn 
     359      READ  ( numnam, namdta_dyn ) 
     360      !                                         ! store namelist information in an array 
     361      !                                         ! Control print 
    323362      IF(lwp) THEN 
    324363         WRITE(numout,*) 
    325          WRITE(numout,*) 'Dynrea : read dynamical fields, kenr = ', jkenr 
    326          WRITE(numout,*) '~~~~~~~' 
    327 #if defined key_degrad 
    328          WRITE(numout,*) ' Degraded fields' 
    329 #endif 
     364         WRITE(numout,*) 'dta_dyn : offline dynamics ' 
     365         WRITE(numout,*) '~~~~~~~ ' 
     366         WRITE(numout,*) '   Namelist namdta_dyn' 
     367         WRITE(numout,*) '      vertical velocity read from file (T) or computed (F) ln_dynwzv  = ', ln_dynwzv 
     368         WRITE(numout,*) '      bbl coef read from file (T) or computed (F)          ln_dynbbl  = ', ln_dynbbl 
     369         WRITE(numout,*) '      degradation option enabled (T) or not (F)            ln_degrad  = ', ln_degrad 
    330370         WRITE(numout,*) 
    331371      ENDIF 
    332  
    333  
    334       IF( kt == nit000 .AND. nlecoff == 0 ) THEN 
    335          nlecoff = 1 
    336          CALL  iom_open ( cfile_grid_T, numfl_t ) 
    337          CALL  iom_open ( cfile_grid_U, numfl_u ) 
    338          CALL  iom_open ( cfile_grid_V, numfl_v ) 
    339          CALL  iom_open ( cfile_grid_W, numfl_w ) 
    340       ENDIF 
    341  
    342       ! file grid-T 
    343       !--------------- 
    344       CALL iom_get( numfl_t, jpdom_data, 'votemper', zt   (:,:,:), jkenr ) 
    345       CALL iom_get( numfl_t, jpdom_data, 'vosaline', zs   (:,:,:), jkenr ) 
    346       CALL iom_get( numfl_t, jpdom_data, 'somixhgt', zmld (:,:  ), jkenr ) 
    347       CALL iom_get( numfl_t, jpdom_data, 'sowaflcd', zemp (:,:  ), jkenr ) 
    348       CALL iom_get( numfl_t, jpdom_data, 'soshfldo', zqsr (:,:  ), jkenr ) 
    349       CALL iom_get( numfl_t, jpdom_data, 'soicecov', zice (:,:  ), jkenr ) 
    350       IF( iom_varid( numfl_t, 'sowindsp', ldstop = .FALSE. ) > 0 ) THEN  
    351          CALL iom_get( numfl_t, jpdom_data, 'sowindsp', zwspd(:,:), jkenr )  
     372      !  
     373      IF( ln_degrad .AND. .NOT.lk_degrad ) THEN 
     374         CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' ) 
     375         ln_degrad = .FALSE. 
     376      ENDIF 
     377      IF( ln_dynbbl .AND. .NOT.lk_trabbl ) THEN 
     378         CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) 
     379         ln_dynbbl = .FALSE. 
     380      ENDIF 
     381 
     382      jf_tem = 1   ;   jf_sal = 2   ;  jf_mld = 3   ;  jf_emp = 4   ;   jf_ice = 5   ;   jf_qsr = 6  
     383      jf_wnd = 7   ;   jf_uwd = 8   ;  jf_vwd = 9   ;  jf_wwd = 10  ;   jf_avt = 11  ;   jfld  = 11 
     384      ! 
     385      slf_d(jf_tem) = sn_tem   ;   slf_d(jf_sal) = sn_sal   ;   slf_d(jf_mld) = sn_mld 
     386      slf_d(jf_emp) = sn_emp   ;   slf_d(jf_ice) = sn_ice   ;   slf_d(jf_qsr) = sn_qsr 
     387      slf_d(jf_wnd) = sn_wnd   ;   slf_d(jf_uwd) = sn_uwd   ;   slf_d(jf_vwd) = sn_vwd 
     388      slf_d(jf_wwd) = sn_wwd   ;   slf_d(jf_avt) = sn_avt  
     389      ! 
     390      IF( .NOT.ln_degrad ) THEN     ! no degrad option 
     391         IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN        ! eiv & bbl 
     392                 jf_ubl  = 12      ;         jf_vbl  = 13      ;         jf_eiw  = 14   ;   jfld = 14 
     393           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl  ;   slf_d(jf_eiw) = sn_eiw 
     394         ENDIF 
     395         IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN   ! no eiv & bbl 
     396                 jf_ubl  = 12      ;         jf_vbl  = 13      ;   jfld = 13 
     397           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
     398         ENDIF 
     399         IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN   ! eiv & no bbl 
     400           jf_eiw = 12   ;   jfld = 12   ;   slf_d(jf_eiw) = sn_eiw 
     401         ENDIF 
    352402      ELSE 
    353          CALL iom_get( numfl_u, jpdom_data, 'sozotaux', ztaux(:,:), jkenr ) 
    354          CALL iom_get( numfl_v, jpdom_data, 'sometauy', ztauy(:,:), jkenr ) 
    355          CALL tau2wnd( ztaux, ztauy, zwspd ) 
    356       ENDIF 
    357       ! files grid-U / grid_V 
    358       CALL iom_get( numfl_u, jpdom_data, 'vozocrtx', zu   (:,:,:), jkenr ) 
    359       CALL iom_get( numfl_v, jpdom_data, 'vomecrty', zv   (:,:,:), jkenr ) 
    360 #if defined key_trabbl 
    361       IF( .NOT. lk_c1d .AND. nn_bbl_ldf == 1 ) THEN 
    362          IF( iom_varid( numfl_u, 'ahu_bbl', ldstop = .FALSE. ) > 0  .AND. & 
    363          &   iom_varid( numfl_v, 'ahv_bbl', ldstop = .FALSE. ) > 0 ) THEN 
    364              CALL iom_get( numfl_u, jpdom_data, 'ahu_bbl', zbblx(:,:), jkenr ) 
    365              CALL iom_get( numfl_v, jpdom_data, 'ahv_bbl', zbbly(:,:), jkenr ) 
    366              l_offbbl = .TRUE. 
    367          ENDIF 
    368       ENDIF 
    369 #endif  
    370  
    371       ! file grid-W 
    372       ! CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw   (:,:,:), jkenr ) 
    373       ! Computation of vertical velocity using horizontal divergence 
    374       CALL wzv( zu, zv, zw ) 
    375  
    376       IF( iom_varid( numfl_w, 'voddmavs', ldstop = .FALSE. ) > 0 ) THEN          ! avs exist: it is used 
    377          CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 
    378       ELSE                                                                       ! no avs: use avt 
    379          CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 
    380       ENDIF 
    381  
    382 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv  
    383       CALL iom_get( numfl_w, jpdom_data, 'soleaeiw', zaeiw2d(:,: ), jkenr ) 
    384 #endif 
    385  
    386 #if defined key_degrad 
    387       CALL iom_get( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr ) 
    388       CALL iom_get( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr ) 
    389       CALL iom_get( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr ) 
    390 #  if defined key_traldf_eiv 
    391       CALL iom_get( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr ) 
    392       CALL iom_get( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr ) 
    393       CALL iom_get( numfl_w, jpdom_data, 'voveaeiw', zaeiw(:,:,:), jkenr ) 
    394 #  endif 
    395 #endif 
    396  
    397       udta  (:,:,:,2) = zu  (:,:,:) * umask(:,:,:) 
    398       vdta  (:,:,:,2) = zv  (:,:,:) * vmask(:,:,:)  
    399       wdta  (:,:,:,2) = zw  (:,:,:) * tmask(:,:,:) 
    400       tdta  (:,:,:,2) = zt  (:,:,:) * tmask(:,:,:) 
    401       sdta  (:,:,:,2) = zs  (:,:,:) * tmask(:,:,:) 
    402       avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 
    403  
    404 #if defined key_ldfslp && ! defined key_c1d 
    405       ! Computes slopes (here tsn and avt are used as workspace) 
    406       ztsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
    407       ztsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
    408       avt(:,:,:)          = avtdta(:,:,:,2) 
    409        
    410       CALL eos( ztsn, rhd, rhop )   ! Time-filtered in situ density  
    411       CALL bn2( ztsn, rn2 )         ! before Brunt-Vaisala frequency 
    412       IF( ln_zps )   & 
    413          &   CALL zps_hde( kt, jpts, ztsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
    414          &                           rhd, gru , grv   )    ! of t, s, rd at the bottom ocean level 
    415       CALL zdf_mxl( kt )           ! mixed layer depth 
    416       CALL ldf_slp( kt, rhd, rn2 ) 
    417           
    418       uslpdta (:,:,:,2) = uslp (:,:,:) 
    419       vslpdta (:,:,:,2) = vslp (:,:,:) 
    420       wslpidta(:,:,:,2) = wslpi(:,:,:) 
    421       wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    422 #endif 
    423  
    424 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    425       aeiwdta(:,:,2)  = zaeiw2d(:,:) * tmask(:,:,1) 
    426 #endif 
    427  
    428 #if defined key_degrad 
    429         ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:) 
    430         ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:) 
    431         ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:) 
    432 #  if defined key_traldf_eiv 
    433         aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:) 
    434         aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:) 
    435         aeiwdta(:,:,:,2) = zaeiw(:,:,:) * tmask(:,:,:) 
    436 #  endif 
    437 #endif 
    438  
    439       ! fluxes  
    440       ! 
    441       wspddta(:,:,2)  = zwspd(:,:) * tmask(:,:,1) 
    442       frlddta(:,:,2)  = zice (:,:) * tmask(:,:,1) 
    443       empdta (:,:,2)  = zemp (:,:) * tmask(:,:,1) 
    444       qsrdta (:,:,2)  = zqsr (:,:) * tmask(:,:,1) 
    445       hmlddta(:,:,2)  = zmld (:,:) * tmask(:,:,1) 
    446  
    447 #if defined key_trabbl 
    448       IF( l_offbbl ) THEN  
    449          bblxdta(:,:,2) = zbblx(:,:)  * umask(:,:,1) 
    450          bblydta(:,:,2) = zbbly(:,:)  * vmask(:,:,1) 
    451       ENDIF 
    452 #endif 
    453        
    454       IF( kt == nitend ) THEN 
    455          CALL iom_close ( numfl_t ) 
    456          CALL iom_close ( numfl_u ) 
    457          CALL iom_close ( numfl_v ) 
    458          CALL iom_close ( numfl_w ) 
    459       ENDIF 
    460       !       
    461       IF( wrk_not_released(3, 3,4,5,6,7,8) .OR. & 
    462           wrk_not_released(4, 1                            ) .OR. & 
    463           wrk_not_released(2, 10,11,12,13,14,15,16,17,18,19)                ) THEN 
    464          CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays') 
    465       END IF 
    466 #if defined key_degrad 
    467       DEALLOCATE( zahtu )   ;   DEALLOCATE( zahtv )   ;   DEALLOCATE( zahtw ) 
    468 # if defined key_traldf_eiv 
    469       DEALLOCATE( zaeiu )   ;   DEALLOCATE( zaeiv )   ;   DEALLOCATE( zaeiw ) 
    470 # endif 
    471 #endif 
    472       ! 
    473    END SUBROUTINE dynrea 
    474  
    475  
    476    SUBROUTINE dta_dyn_init 
    477       !!---------------------------------------------------------------------- 
    478       !!                  ***  ROUTINE dta_dyn_init  *** 
    479       !! 
    480       !! ** Purpose :   initializations of parameters for the interpolation 
    481       !! 
    482       !! ** Method : 
    483       !!---------------------------------------------------------------------- 
    484       REAL(wp) :: znspyr   !: number of time step per year 
    485       ! 
    486       NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn,  & 
    487          &             cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
    488       !!---------------------------------------------------------------------- 
    489       ! 
    490       IF( dta_dyn_alloc() /= 0 )  CALL ctl_stop( 'STOP', 'dta_dyn_alloc: unable to allocate standard ocean arrays' ) 
    491       ! 
    492       REWIND( numnam )              ! Read Namelist namdyn : Lateral physics on tracers 
    493       READ  ( numnam, namdyn ) 
    494       ! 
    495       IF(lwp) THEN                  ! control print 
    496          WRITE(numout,*) 
    497          WRITE(numout,*) 'namdyn : offline dynamical selection' 
    498          WRITE(numout,*) '~~~~~~~' 
    499          WRITE(numout,*) '  Namelist namdyn : set parameters for the lecture of the dynamical fields' 
    500          WRITE(numout,*)  
    501          WRITE(numout,*) ' number of elements in the FILE for a year  ndtadyn = ' , ndtadyn 
    502          WRITE(numout,*) ' total number of elements in the FILE       ndtatot = ' , ndtatot 
    503          WRITE(numout,*) ' type of interpolation                      nsptint = ' , nsptint 
    504          WRITE(numout,*) ' loop on the same FILE                      lperdyn = ' , lperdyn 
    505          WRITE(numout,*) '  ' 
    506          WRITE(numout,*) ' name of grid_T file                   cfile_grid_T = ', TRIM(cfile_grid_T)     
    507          WRITE(numout,*) ' name of grid_U file                   cfile_grid_U = ', TRIM(cfile_grid_U)  
    508          WRITE(numout,*) ' name of grid_V file                   cfile_grid_V = ', TRIM(cfile_grid_V)  
    509          WRITE(numout,*) ' name of grid_W file                   cfile_grid_W = ', TRIM(cfile_grid_W)       
    510          WRITE(numout,*) ' ' 
    511       ENDIF 
    512       ! 
    513       znspyr   = nyear_len(1) * rday / rdt   
    514       rnspdta  = znspyr / REAL( ndtadyn, wp ) 
    515       rnspdta2 = rnspdta * 0.5  
     403              jf_ahu  = 12      ;         jf_ahv  = 13      ;         jf_ahw  = 14   ;   jfld = 14 
     404        slf_d(jf_ahu) = sn_ahu  ;   slf_d(jf_ahv) = sn_ahv  ;   slf_d(jf_ahw) = sn_ahw 
     405        IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN         ! eiv & bbl 
     406                 jf_ubl  = 15      ;         jf_vbl  = 16       
     407           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl   
     408                 jf_eiu  = 17      ;         jf_eiv  = 18      ;          jf_eiw  = 19   ;   jfld = 19 
     409           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;    slf_d(jf_eiw) = sn_eiw 
     410        ENDIF 
     411        IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN    ! no eiv & bbl 
     412                 jf_ubl  = 15      ;         jf_vbl  = 16      ;   jfld = 16 
     413           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
     414        ENDIF 
     415        IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN    ! eiv & no bbl 
     416                 jf_eiu  = 15      ;         jf_eiv  = 16      ;         jf_eiw  = 17   ;   jfld = 17 
     417           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;   slf_d(jf_eiw) = sn_eiw 
     418        ENDIF 
     419      ENDIF 
     420   
     421      ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure 
     422      IF( ierr > 0 ) THEN 
     423         CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' )   ;   RETURN 
     424      ENDIF 
     425      ! Open file for each variable to get his number of dimension 
     426      DO ifpr = 1, jfld 
     427         CALL iom_open( slf_d(ifpr)%clname, inum ) 
     428         idv   = iom_varid( inum , slf_d(ifpr)%clvar )  ! id of the variable sdjf%clvar 
     429         idimv = iom_file ( inum )%ndims(idv)             ! number of dimension for variable sdjf%clvar 
     430         IF( inum /= 0 )   CALL iom_close( inum )       ! close file if already open 
     431         IF( idimv == 3 ) THEN    ! 2D variable 
     432                                      ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
     433            IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 ) 
     434         ELSE                     ! 3D variable 
     435                                      ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,jpk)  , STAT=ierr0 ) 
     436            IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,jpk,2), STAT=ierr1 ) 
     437         ENDIF 
     438         IF( ierr0 + ierr1 > 0 ) THEN 
     439            CALL ctl_stop( 'dta_dyn_init : unable to allocate sf_dyn array structure' )   ;   RETURN 
     440         ENDIF 
     441      END DO 
     442      !                                         ! fill sf with slf_i and control print 
     443      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 
     444      ! 
     445      IF( lk_ldfslp ) THEN                  ! slopes  
     446         IF( sf_dyn(jf_tem)%ln_tint ) THEN      ! time interpolation 
     447            ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
     448            &         wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), STAT=ierr2 ) 
     449         ELSE 
     450            ALLOCATE( uslpnow (jpi,jpj,jpk)  , vslpnow (jpi,jpj,jpk)  ,    & 
     451            &         wslpinow(jpi,jpj,jpk)  , wslpjnow(jpi,jpj,jpk)  , STAT=ierr2 ) 
     452         ENDIF  
     453         IF( ierr2 > 0 ) THEN 
     454            CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' )   ;   RETURN 
     455         ENDIF 
     456      ENDIF 
     457      IF( ln_dynwzv ) THEN                  ! slopes  
     458         IF( sf_dyn(jf_uwd)%ln_tint ) THEN      ! time interpolation 
     459            ALLOCATE( wdta(jpi,jpj,jpk,2), STAT=ierr3 ) 
     460         ELSE 
     461            ALLOCATE( wnow(jpi,jpj,jpk)  , STAT=ierr3 ) 
     462         ENDIF  
     463         IF( ierr3 > 0 ) THEN 
     464            CALL ctl_stop( 'dta_dyn_init : unable to allocate wdta arrays' )   ;   RETURN 
     465         ENDIF 
     466      ENDIF 
    516467      ! 
    517468      CALL dta_dyn( nit000 ) 
    … …  
    519470   END SUBROUTINE dta_dyn_init 
    520471 
    521  
    522    SUBROUTINE wzv( pu, pv, pw ) 
     472   SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 
    523473      !!---------------------------------------------------------------------- 
    524474      !!                    ***  ROUTINE wzv  *** 
    … …  
    534484      !!        The boundary conditions are w=0 at the bottom (no flux). 
    535485      !!---------------------------------------------------------------------- 
     486      USE oce, ONLY:  zhdiv => hdivn 
     487      ! 
    536488      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pu, pv    !:  horizontal velocities 
    537       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  verticla velocity 
     489      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  vertical velocity 
    538490      !! 
    539491      INTEGER  ::  ji, jj, jk 
    540492      REAL(wp) ::  zu, zu1, zv, zv1, zet 
    541       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhdiv     !:  horizontal divergence 
    542493      !!---------------------------------------------------------------------- 
    543494      ! 
    544495      ! Computation of vertical velocity using horizontal divergence 
    545       zhdiv(:,:,:) = 0. 
     496      zhdiv(:,:,:) = 0._wp 
    546497      DO jk = 1, jpkm1 
    547498         DO jj = 2, jpjm1 
    … …  
    564515      END DO 
    565516      ! 
    566    END SUBROUTINE wzv 
    567  
    568  
    569    SUBROUTINE dta_eiv( kt ) 
    570       !!---------------------------------------------------------------------- 
    571       !!                  ***  ROUTINE dta_eiv  *** 
    572       !! 
    573       !! ** Purpose :   Compute the eddy induced velocity coefficient from the 
    574       !!      growth rate of baroclinic instability. 
    575       !! 
    576       !! ** Method : Specific to the offline model. Computes the horizontal 
    577       !!             values from the vertical value 
    578       !!---------------------------------------------------------------------- 
    579       INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx 
    580       !! 
    581       INTEGER ::   ji, jj           ! dummy loop indices 
    582       !!---------------------------------------------------------------------- 
    583       ! 
    584       IF( kt == nit000 ) THEN 
    585          IF(lwp) WRITE(numout,*) 
    586          IF(lwp) WRITE(numout,*) 'dta_eiv : eddy induced velocity coefficients' 
    587          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    588       ENDIF 
    589       ! 
    590 #if defined key_ldfeiv 
    591       ! Average the diffusive coefficient at u- v- points 
    592       DO jj = 2, jpjm1 
    593          DO ji = fs_2, fs_jpim1   ! vector opt. 
    594             aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) ) 
    595             aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) ) 
    596          END DO 
    597       END DO 
    598       CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition 
     517   END SUBROUTINE dta_dyn_wzv 
     518 
     519   SUBROUTINE dta_dyn_slp( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 
     520      !!--------------------------------------------------------------------- 
     521      !!                    ***  ROUTINE dta_dyn_slp  *** 
     522      !! 
     523      !! ** Purpose : Computation of slope 
     524      !! 
     525      !!--------------------------------------------------------------------- 
     526      INTEGER ,                              INTENT(in ) :: kt       ! time step 
     527      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts      ! temperature/salinity 
     528      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: puslp    ! zonal isopycnal slopes 
     529      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pvslp    ! meridional isopycnal slopes 
     530      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpi   ! zonal diapycnal slopes 
     531      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes 
     532      !!  
     533#if defined key_ldfslp && ! defined key_c1d 
     534      CALL eos( pts, rhd, rhop )   ! Time-filtered in situ density  
     535      CALL bn2( pts, rn2 )         ! before Brunt-Vaisala frequency 
     536      IF( ln_zps )   & 
     537         &  CALL zps_hde( kt, jpts, pts, gtsu, gtsv, rhd, gru, grv )  ! Partial steps: before Horizontal DErivative 
     538         !                                                            ! of t, s, rd at the bottom ocean level 
     539      CALL zdf_mxl( kt )            ! mixed layer depth 
     540      CALL ldf_slp( kt, rhd, rn2 )  ! slopes 
     541      puslp (:,:,:) = uslp (:,:,:)  
     542      pvslp (:,:,:) = vslp (:,:,:)  
     543      pwslpi(:,:,:) = wslpi(:,:,:)  
     544      pwslpj(:,:,:) = wslpj(:,:,:)  
     545#else 
     546      WRITE(*,*) 'dta_dyn_slp: You should not have seen this print! error?', & 
     547        &        kt, pts(1,1,1,1),puslp(1,1,1), pvslp(1,1,1), pwslpi(1,1,1), pwslpj(1,1,1) 
    599548#endif 
    600549      ! 
    601    END SUBROUTINE dta_eiv 
    602  
    603  
    604    SUBROUTINE tau2wnd( ptaux, ptauy, pwspd ) 
    605       !!--------------------------------------------------------------------- 
    606       !!                    ***  ROUTINE sbc_tau2wnd  *** 
    607       !! 
    608       !! ** Purpose : Estimation of wind speed as a function of wind stress 
    609       !! 
    610       !! ** Method  : |tau|=rhoa*Cd*|U|^2 
    611       !!--------------------------------------------------------------------- 
    612       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptaux, ptauy   ! wind stress in i-j direction resp. 
    613       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pwspd          ! wind speed 
    614       !!  
    615       REAL(wp) ::   zrhoa  = 1.22_wp       ! Air density kg/m3 
    616       REAL(wp) ::   zcdrag = 1.5e-3_wp     ! drag coefficient 
    617       REAL(wp) ::   ztx, zty, ztau, zcoef  ! temporary variables 
    618       INTEGER  ::   ji, jj                 ! dummy indices 
    619       !!--------------------------------------------------------------------- 
    620       zcoef = 1. / ( zrhoa * zcdrag ) 
    621 !CDIR NOVERRCHK 
    622       DO jj = 2, jpjm1 
    623 !CDIR NOVERRCHK 
    624          DO ji = fs_2, fs_jpim1   ! vector opt. 
    625             ztx = ptaux(ji,jj) * umask(ji,jj,1) + ptaux(ji-1,jj  ) * umask(ji-1,jj  ,1) 
    626             zty = ptauy(ji,jj) * vmask(ji,jj,1) + ptauy(ji  ,jj-1) * vmask(ji  ,jj-1,1) 
    627             ztau = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    628             pwspd(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1) 
    629          END DO 
    630       END DO 
    631       CALL lbc_lnk( pwspd(:,:), 'T', 1. ) 
    632       ! 
    633    END SUBROUTINE tau2wnd 
    634  
    635  
    636    SUBROUTINE swap_dyn_data 
    637       !!---------------------------------------------------------------------- 
    638       !!                    ***  ROUTINE swap_dyn_data  *** 
    639       !! 
    640       !! ** Purpose :   swap array data 
    641       !!---------------------------------------------------------------------- 
    642       ! 
    643       ! swap from record 2 to 1 
    644       tdta   (:,:,:,1) = tdta   (:,:,:,2) 
    645       sdta   (:,:,:,1) = sdta   (:,:,:,2) 
    646       avtdta (:,:,:,1) = avtdta (:,:,:,2) 
    647       udta   (:,:,:,1) = udta   (:,:,:,2) 
    648       vdta   (:,:,:,1) = vdta   (:,:,:,2) 
    649       wdta   (:,:,:,1) = wdta   (:,:,:,2) 
    650 #if defined key_ldfslp && ! defined key_c1d 
    651       uslpdta (:,:,:,1) = uslpdta (:,:,:,2) 
    652       vslpdta (:,:,:,1) = vslpdta (:,:,:,2) 
    653       wslpidta(:,:,:,1) = wslpidta(:,:,:,2) 
    654       wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 
    655 #endif 
    656       hmlddta(:,:,1) = hmlddta(:,:,2)  
    657       wspddta(:,:,1) = wspddta(:,:,2)  
    658       frlddta(:,:,1) = frlddta(:,:,2)  
    659       empdta (:,:,1) = empdta (:,:,2)  
    660       qsrdta (:,:,1) = qsrdta (:,:,2)  
    661       IF( l_offbbl ) THEN 
    662          bblxdta(:,:,1) = bblxdta(:,:,2) 
    663          bblydta(:,:,1) = bblydta(:,:,2)  
    664       ENDIF 
    665  
    666 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    667       aeiwdta(:,:,1) = aeiwdta(:,:,2) 
    668 #endif 
    669  
    670 #if defined key_degrad 
    671       ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 
    672       ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 
    673       ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 
    674 #  if defined key_traldf_eiv 
    675       aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 
    676       aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 
    677       aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2) 
    678 #  endif 
    679 #endif 
    680       ! 
    681    END SUBROUTINE swap_dyn_data 
    682  
    683  
    684    SUBROUTINE assign_dyn_data 
    685       !!---------------------------------------------------------------------- 
    686       !!                    ***  ROUTINE assign_dyn_data  *** 
    687       !! 
    688       !! ** Purpose :   Assign dynamical data to the data that have been read 
    689       !!                without time interpolation 
    690       !! 
    691       !!---------------------------------------------------------------------- 
    692        
    693       tsn(:,:,:,jp_tem) = tdta  (:,:,:,2) 
    694       tsn(:,:,:,jp_sal) = sdta  (:,:,:,2) 
    695       avt(:,:,:)        = avtdta(:,:,:,2) 
    696        
    697       un (:,:,:) = udta  (:,:,:,2)  
    698       vn (:,:,:) = vdta  (:,:,:,2) 
    699       wn (:,:,:) = wdta  (:,:,:,2) 
    700        
    701 #if defined key_ldfslp && ! defined key_c1d 
    702       uslp (:,:,:) = uslpdta (:,:,:,2)  
    703       vslp (:,:,:) = vslpdta (:,:,:,2)  
    704       wslpi(:,:,:) = wslpidta(:,:,:,2)  
    705       wslpj(:,:,:) = wslpjdta(:,:,:,2)  
    706 #endif 
    707  
    708       hmld(:,:) = hmlddta(:,:,2)  
    709       wndm(:,:) = wspddta(:,:,2)  
    710       fr_i(:,:) = frlddta(:,:,2)  
    711       emp (:,:) = empdta (:,:,2)  
    712       emps(:,:) = emp(:,:)  
    713       qsr (:,:) = qsrdta (:,:,2)  
    714 #if defined key_trabbl 
    715       IF( l_offbbl ) THEN 
    716          ahu_bbl(:,:) = bblxdta(:,:,2) 
    717          ahv_bbl(:,:) = bblydta(:,:,2)  
    718       ENDIF 
    719 #endif 
    720 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    721       aeiw(:,:) = aeiwdta(:,:,2) 
    722 #endif 
    723        
    724 #if defined key_degrad 
    725       ahtu(:,:,:) = ahtudta(:,:,:,2) 
    726       ahtv(:,:,:) = ahtvdta(:,:,:,2) 
    727       ahtw(:,:,:) = ahtwdta(:,:,:,2) 
    728 #  if defined key_traldf_eiv 
    729       aeiu(:,:,:) = aeiudta(:,:,:,2) 
    730       aeiv(:,:,:) = aeivdta(:,:,:,2) 
    731       aeiw(:,:,:) = aeiwdta(:,:,:,2) 
    732 #  endif 
    733 #endif 
    734       ! 
    735    END SUBROUTINE assign_dyn_data 
    736  
    737  
    738    SUBROUTINE linear_interp_dyn_data( pweigh ) 
    739       !!---------------------------------------------------------------------- 
    740       !!               ***  ROUTINE linear_interp_dyn_data  *** 
    741       !! 
    742       !! ** Purpose :   linear interpolation of data 
    743       !!---------------------------------------------------------------------- 
    744       REAL(wp), INTENT(in) ::   pweigh   ! weigh 
    745       !! 
    746       REAL(wp) :: zweighm1 
    747       !!---------------------------------------------------------------------- 
    748  
    749       zweighm1 = 1. - pweigh 
    750        
    751       tsn(:,:,:,jp_tem) = zweighm1 * tdta  (:,:,:,1) + pweigh * tdta  (:,:,:,2) 
    752       tsn(:,:,:,jp_sal) = zweighm1 * sdta  (:,:,:,1) + pweigh * sdta  (:,:,:,2) 
    753       avt(:,:,:)        = zweighm1 * avtdta(:,:,:,1) + pweigh * avtdta(:,:,:,2) 
    754        
    755       un (:,:,:) = zweighm1 * udta  (:,:,:,1) + pweigh * udta  (:,:,:,2)  
    756       vn (:,:,:) = zweighm1 * vdta  (:,:,:,1) + pweigh * vdta  (:,:,:,2) 
    757       wn (:,:,:) = zweighm1 * wdta  (:,:,:,1) + pweigh * wdta  (:,:,:,2) 
    758        
    759 #if defined key_ldfslp && ! defined key_c1d 
    760       uslp (:,:,:) = zweighm1 * uslpdta (:,:,:,1) + pweigh * uslpdta (:,:,:,2)  
    761       vslp (:,:,:) = zweighm1 * vslpdta (:,:,:,1) + pweigh * vslpdta (:,:,:,2)  
    762       wslpi(:,:,:) = zweighm1 * wslpidta(:,:,:,1) + pweigh * wslpidta(:,:,:,2)  
    763       wslpj(:,:,:) = zweighm1 * wslpjdta(:,:,:,1) + pweigh * wslpjdta(:,:,:,2)  
    764 #endif 
    765  
    766       hmld(:,:) = zweighm1 * hmlddta(:,:,1) + pweigh  * hmlddta(:,:,2)  
    767       wndm(:,:) = zweighm1 * wspddta(:,:,1) + pweigh  * wspddta(:,:,2)  
    768       fr_i(:,:) = zweighm1 * frlddta(:,:,1) + pweigh  * frlddta(:,:,2)  
    769       emp (:,:) = zweighm1 * empdta (:,:,1) + pweigh  * empdta (:,:,2)  
    770       emps(:,:) = emp(:,:)  
    771       qsr (:,:) = zweighm1 * qsrdta (:,:,1) + pweigh  * qsrdta (:,:,2)  
    772 #if defined key_trabbl 
    773       IF( l_offbbl ) THEN 
    774          ahu_bbl(:,:) = zweighm1 * bblxdta(:,:,1) +  pweigh  * bblxdta(:,:,2) 
    775          ahv_bbl(:,:) = zweighm1 * bblydta(:,:,1) +  pweigh  * bblydta(:,:,2) 
    776       ENDIF 
    777 #endif 
    778  
    779 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv  
    780       aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + pweigh * aeiwdta(:,:,2) 
    781 #endif 
    782        
    783 #if defined key_degrad 
    784       ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + pweigh * ahtudta(:,:,:,2) 
    785       ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + pweigh * ahtvdta(:,:,:,2) 
    786       ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + pweigh * ahtwdta(:,:,:,2) 
    787 #  if defined key_traldf_eiv 
    788       aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + pweigh * aeiudta(:,:,:,2) 
    789       aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + pweigh * aeivdta(:,:,:,2) 
    790       aeiw(:,:,:) = zweighm1 * aeiwdta(:,:,:,1) + pweigh * aeiwdta(:,:,:,2) 
    791 #  endif 
    792 #endif 
    793       !       
    794    END SUBROUTINE linear_interp_dyn_data 
    795  
     550   END SUBROUTINE dta_dyn_slp 
    796551   !!====================================================================== 
    797552END MODULE dtadyn 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90

    r2399 r2977  
    105105            ! 
    106106            !                                      ! Write the information 
    107             CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   ) 
    108             CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un      ) 
    109             CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn      ) 
    110             CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tn      ) 
    111             CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , sn      ) 
    112             CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn    ) 
    113 #if defined key_zdftke 
    114             CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en      ) 
    115 #endif 
    116             CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx     ) 
     107            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             ) 
     108            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                ) 
     109            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                ) 
     110            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) ) 
     111            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
     112            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              ) 
     113#if defined key_zdftke 
     114            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
     115#endif 
     116            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               ) 
    117117            ! 
    118118            CALL iom_close( inum ) 
    … …  
    143143            ! 
    144144            !                                      ! Write the information 
    145             CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate   ) 
    146             CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un      ) 
    147             CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn      ) 
    148             CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tn      ) 
    149             CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , sn      ) 
    150             CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn    ) 
     145            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             ) 
     146            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                ) 
     147            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                ) 
     148            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) ) 
     149            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
     150            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              ) 
    151151            ! 
    152152            CALL iom_close( inum ) 
    … …  
    216216         CALL iom_rstput( it, it, inum, 'un'    , un     ) 
    217217         CALL iom_rstput( it, it, inum, 'vn'    , vn     ) 
    218          CALL iom_rstput( it, it, inum, 'tn'    , tn    ) 
    219          CALL iom_rstput( it, it, inum, 'sn'    , sn    ) 
     218         CALL iom_rstput( it, it, inum, 'tn'    , tsn(:,:,:,jp_tem) ) 
     219         CALL iom_rstput( it, it, inum, 'sn'    , tsn(:,:,:,jp_sal) ) 
    220220         CALL iom_rstput( it, it, inum, 'avmu'  , avmu   ) 
    221221         CALL iom_rstput( it, it, inum, 'avmv'  , avmv   ) 
    … …  
    230230         CALL iom_rstput( it, it, inum, 'avs'   , avs    ) 
    231231#endif 
    232          CALL iom_rstput( it, it, inum, 'ta'    , ta    ) 
    233          CALL iom_rstput( it, it, inum, 'sa'    , sa    ) 
    234          CALL iom_rstput( it, it, inum, 'tb'    , tb    ) 
    235          CALL iom_rstput( it, it, inum, 'sb'    , sb    ) 
    236 #if defined key_tradmp 
    237          CALL iom_rstput( it, it, inum, 'strdmp', strdmp ) 
    238          CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   ) 
    239 #endif 
     232         CALL iom_rstput( it, it, inum, 'ta'    , tsa(:,:,:,jp_tem) ) 
     233         CALL iom_rstput( it, it, inum, 'sa'    , tsa(:,:,:,jp_sal) ) 
     234         CALL iom_rstput( it, it, inum, 'tb'    , tsb(:,:,:,jp_tem) ) 
     235         CALL iom_rstput( it, it, inum, 'sb'    , tsb(:,:,:,jp_sal) ) 
     236         IF( ln_tradmp ) THEN 
     237            CALL iom_rstput( it, it, inum, 'strdmp', strdmp ) 
     238            CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   ) 
     239         END IF 
    240240         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu   ) 
    241241         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   ) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r2715 r2977  
    332332                  ij = nbj(ib,igrd) 
    333333                  DO ik = 1, jpkm1 
    334                      tbdy(ib,ik) = tn(ii,ij,ik) 
    335                      sbdy(ib,ik) = sn(ii,ij,ik) 
     334                     tbdy(ib,ik) = tsn(ii,ij,ik,jp_tem) 
     335                     sbdy(ib,ik) = tsn(ii,ij,ik,jp_sal) 
    336336                  END DO 
    337337               END DO 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r2528 r2977  
    6161               ij = nbj(ib,igrd) 
    6262               zwgt = nbw(ib,igrd) 
    63                ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)          
    64                sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 
     63               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)          
     64               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 
    6565            END DO 
    6666         END DO  
    67          ! 
    68          CALL lbc_lnk( ta, 'T', 1. )   ; CALL lbc_lnk( sa, 'T', 1. )    ! Boundary points should be updated 
     67         !                                              ! Boundary points should be updated 
     68         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      
     69         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )     
    6970         ! 
    7071      ENDIF ! ln_tra_frs 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r2409 r2977  
    6464      ! Update data, open boundaries, surface boundary condition (including sea-ice) 
    6565      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    66       IF( lk_dtatem  )   CALL dta_tem( kstp )         ! update 3D temperature data 
    67       IF( lk_dtasal  )   CALL dta_sal( kstp )         ! update 3D salinity data 
    6866                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    6967 
    … …  
    127125      IF( ln_zdfnpc      )   CALL tra_npc    ( kstp )        ! applied non penetrative convective adjustment on (t,s) 
    128126                             CALL eos( tsb, rhd, rhop )      ! now (swap=before) in situ density for dynhpg module 
    129                              CALL tra_unswap                 ! udate T & S 3D arrays  (to be suppressed) 
    130127 
    131128      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r2715 r2977  
    9494      CALL iom_put( 'sshtot', zvolssh / area_tot ) 
    9595 
    96       !                                         ! thermosteric ssh 
    97       ztsn(:,:,:,jp_tem) = tn (:,:,:) 
     96      !                      
     97      ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
    9898      ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    9999      CALL eos( ztsn, zrhd )                       ! now in situ density using initial salinity 
    … …  
    138138            DO ji = 1, jpi 
    139139               zztmp = area(ji,jj) * fse3t(ji,jj,jk) 
    140                ztemp = ztemp + zztmp * tn(ji,jj,jk) 
    141                zsal  = zsal  + zztmp * sn(ji,jj,jk) 
     140               ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 
     141               zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal) 
    142142            END DO 
    143143         END DO 
    144144      END DO 
    145145      IF( .NOT.lk_vvl ) THEN 
    146          ztemp = ztemp + SUM( zarea_ssh(:,:) * tn(:,:,1) ) 
    147          zsal  = zsal  + SUM( zarea_ssh(:,:) * sn(:,:,1) ) 
     146         ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 
     147         zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 
    148148      ENDIF 
    149149      IF( lk_mpp ) THEN   

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r2528 r2977  
    8080               DO ji = fs_2, fs_jpim1   ! vector opt. 
    8181                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    82                   a_salb = a_salb + ( sb(ji,jj,jk) - zsm0 ) * zwei 
     82                  a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    8383               END DO 
    8484            END DO 
    … …  
    106106               DO ji = fs_2, fs_jpim1   ! vector opt. 
    107107                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    108                   a_saln = a_saln + ( sn(ji,jj,jk) - zsm0 ) * zwei 
     108                  a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    109109                  zvol  = zvol  + zwei 
    110110               END DO 
    … …  
    177177            DO jj = mj0(ij0), mj1(ij1) 
    178178               DO jk = 1, jpk  
    179                   zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    180                   zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) 
     179                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     180                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    181181                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    182182 
    … …  
    224224            DO jj = mj0(ij0), mj1(ij1) 
    225225               DO jk = 1, jpk  
    226                   zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    227                   zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) 
     226                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     227                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    228228                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    229229                   
    … …  
    271271            DO jj = mj0(ij0), mj1(ij1) 
    272272               DO jk = 1, jpk  
    273                   zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    274                   zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) 
     273                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     274                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    275275                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    276276                   
    … …  
    318318            DO jj = mj0(ij0), mj1(ij1) 
    319319               DO jk = 1, jpk 
    320                   zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    321                   zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) 
     320                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     321                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    322322                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    323323                   

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r2528 r2977  
    107107         ! heat content variation 
    108108         zdiff_hc = zdiff_hc + SUM( surf(:,:) * tmask(:,:,jk)          & 
    109             &                       * ( fse3t_n(:,:,jk) * tn(:,:,jk)   & 
     109            &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem)   & 
    110110            &                           - hc_loc_ini(:,:,jk) ) ) 
    111111         ! salt content variation 
    112112         zdiff_sc = zdiff_sc + SUM( surf(:,:) * tmask(:,:,jk)          & 
    113             &                       * ( fse3t_n(:,:,jk) * sn(:,:,jk)   & 
     113            &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal)   & 
    114114            &                           - sc_loc_ini(:,:,jk) ) ) 
    115115      ENDDO 
    … …  
    248248      ! 4 - initial conservation variables ! 
    249249      ! ---------------------------------- ! 
    250       ssh_ini(:,:) = sshn(:,:)                               ! initial ssh 
     250      ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
    251251      DO jk = 1, jpk 
    252          e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                ! initial vertical scale factors 
    253          hc_loc_ini(:,:,jk) = tn(:,:,jk) * fse3t_n(:,:,jk)   ! initial heat content 
    254          sc_loc_ini(:,:,jk) = sn(:,:,jk) * fse3t_n(:,:,jk)   ! initial salt content 
     252         e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
     253         hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
     254         sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
    255255      END DO 
    256256      frc_v = 0.d0                                           ! volume       trend due to forcing 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r2715 r2977  
    160160         DO ji = 1, jpi 
    161161            IF( tmask(ji,jj,nla10) == 1. ) THEN 
    162                zu  =  1779.50 + 11.250*tn(ji,jj,nla10) - 3.80*sn(ji,jj,nla10) - 0.0745*tn(ji,jj,nla10)*tn(ji,jj,nla10)   & 
    163                   &                                                           - 0.0100*tn(ji,jj,nla10)*sn(ji,jj,nla10) 
    164                zv  =  5891.00 + 38.000*tn(ji,jj,nla10) + 3.00*sn(ji,jj,nla10) - 0.3750*tn(ji,jj,nla10)*tn(ji,jj,nla10) 
    165                zut =    11.25 -  0.149*tn(ji,jj,nla10) - 0.01*sn(ji,jj,nla10) 
    166                zvt =    38.00 -  0.750*tn(ji,jj,nla10) 
     162               zu  =  1779.50 + 11.250 * tsn(ji,jj,nla10,jp_tem) - 3.80   * tsn(ji,jj,nla10,jp_sal)                             & 
     163                  &                                              - 0.0745 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)   & 
     164                  &                                              - 0.0100 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_sal) 
     165               zv  =  5891.00 + 38.000 * tsn(ji,jj,nla10,jp_tem) + 3.00   * tsn(ji,jj,nla10,jp_sal)                             & 
     166                  &                                              - 0.3750 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem) 
     167               zut =    11.25 -  0.149 * tsn(ji,jj,nla10,jp_tem) - 0.01   * tsn(ji,jj,nla10,jp_sal) 
     168               zvt =    38.00 -  0.750 * tsn(ji,jj,nla10,jp_tem) 
    167169               zw  = (zu + 0.698*zv) * (zu + 0.698*zv) 
    168170               zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) 
    … …  
    184186               ! 
    185187               zzdep = fsdepw(ji,jj,jk) 
    186                zztmp = ( tn(ji,jj,jk-1) - tn(ji,jj,jk) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
     188               zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
    187189               zzdep = zzdep * tmask(ji,jj,1) 
    188190 
    … …  
    221223               zzdep = fsdepw(ji,jj,jk) * tmask(ji,jj,1) 
    222224               ! 
    223                zztmp = tn(ji,jj,nla10) - tn(ji,jj,jk)                  ! - delta T(10m) 
     225               zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem)  ! - delta T(10m) 
    224226               IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2 
    225227               IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2 
    … …  
    254256         DO jj = 1, jpj 
    255257            DO ji = 1, jpi 
    256                zztmp = tn(ji,jj,jk) 
     258               zztmp = tsn(ji,jj,jk,jp_tem) 
    257259               IF( zztmp >= 20. )   ik20(ji,jj) = jk 
    258260               IF( zztmp >= 28. )   ik28(ji,jj) = jk 
    … …  
    273275               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation 
    274276                  &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   & 
    275                   &  * ( 20.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                       )   & 
    276                   &  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + (1.-tmask(ji,jj,1)) ) 
     277                  &  * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem)                       )   & 
     278                  &  / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) 
    277279               hd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth 
    278280            ELSE  
    … …  
    284286               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation 
    285287                  &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   & 
    286                   &  * ( 28.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                       )   & 
    287                   &  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + (1.-tmask(ji,jj,1)) ) 
     288                  &  * ( 28.*tmask(ji,jj,iid+1) -    tsn(ji,jj,iid,jp_tem)                       )   & 
     289                  &  / (  tsn(ji,jj,iid+1,jp_tem) -    tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) 
    288290               hd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1)      ! bound by the ocean depth 
    289291            ELSE  
    … …  
    309311      ! surface boundary condition 
    310312      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                    
    311       ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tn(:,:,jk) * sshn(:,:) * tmask(:,:,jk)    
     313      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,jk,jp_tem) * sshn(:,:) * tmask(:,:,jk)    
    312314      ENDIF 
    313315      ! integration down to ilevel 
    314316      DO jk = 1, ilevel 
    315317         zthick(:,:) = zthick(:,:) + fse3t(:,:,jk) 
    316          htc3  (:,:) = htc3  (:,:) + fse3t(:,:,jk) * tn(:,:,jk) * tmask(:,:,jk) 
     318         htc3  (:,:) = htc3  (:,:) + fse3t(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk) 
    317319      END DO 
    318320      ! deepest layer 
    … …  
    320322      DO jj = 1, jpj 
    321323         DO ji = 1, jpi 
    322             htc3(ji,jj) = htc3(ji,jj) + tn(ji,jj,ilevel+1) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 
     324            htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 
    323325         END DO 
    324326      END DO 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r2715 r2977  
    349349            IF( ln_diaznl ) THEN               ! i-mean temperature and salinity 
    350350               DO jn = 1, nptr 
    351                   tn_jk(:,:,jn) = ptr_tjk( tn(:,:,:), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     351                  tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    352352               END DO 
    353353            ENDIF 
    … …  
    368368            ! 
    369369            !                          ! Transports 
    370             !                                ! local heat & salt transports at T-points  ( tn*mj[vn+v_eiv] ) 
     370            !                                ! local heat & salt transports at T-points  ( tsn*mj[vn+v_eiv] ) 
    371371            vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp 
    372372            DO jk= 1, jpkm1 
    … …  
    378378                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 
    379379#endif  
    380                      vt(:,jj,jk) = zv * tn(:,jj,jk) 
    381                      vs(:,jj,jk) = zv * sn(:,jj,jk) 
     380                     vt(:,jj,jk) = zv * tsn(:,jj,jk,jp_tem) 
     381                     vs(:,jj,jk) = zv * tsn(:,jj,jk,jp_sal) 
    382382                  END DO 
    383383               END DO 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r2715 r2977  
    4646   USE limwri_2  
    4747#endif 
    48    USE dtatem 
    49    USE dtasal 
    5048   USE lib_mpp         ! MPP library 
    5149 
    … …  
    116114      !! ** Method  :  use iom_put 
    117115      !!---------------------------------------------------------------------- 
    118       USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace 
    119116      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     117      USE wrk_nemo, ONLY: z3d => wrk_3d_1 
    120118      USE wrk_nemo, ONLY: z2d => wrk_2d_1 
    121119      !! 
    … …  
    126124      !!---------------------------------------------------------------------- 
    127125      !  
    128       IF( wrk_in_use(2, 1))THEN 
    129          CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.') 
    130          RETURN 
     126      IF(  wrk_in_use(3, 1) .OR. wrk_in_use(2, 1) ) THEN 
     127         CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.')  ;  RETURN 
    131128      END IF 
    132129      ! 
    … …  
    137134      ENDIF 
    138135 
    139       CALL iom_put( "toce"   , tn                    )    ! temperature 
    140       CALL iom_put( "soce"   , sn                    )    ! salinity 
    141       CALL iom_put( "sst"    , tn(:,:,1)             )    ! sea surface temperature 
    142       CALL iom_put( "sst2"   , tn(:,:,1) * tn(:,:,1) )    ! square of sea surface temperature 
    143       CALL iom_put( "sss"    , sn(:,:,1)             )    ! sea surface salinity 
    144       CALL iom_put( "sss2"   , sn(:,:,1) * sn(:,:,1) )    ! square of sea surface salinity 
    145       CALL iom_put( "uoce"   , un                    )    ! i-current       
    146       CALL iom_put( "voce"   , vn                    )    ! j-current 
     136      CALL iom_put( "toce"   , tsn(:,:,:,jp_tem)                     )    ! temperature 
     137      CALL iom_put( "soce"   , tsn(:,:,:,jp_sal)                     )    ! salinity 
     138      CALL iom_put( "sst"    , tsn(:,:,1,jp_tem)                     )    ! sea surface temperature 
     139      CALL iom_put( "sst2"   , tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) )    ! square of sea surface temperature 
     140      CALL iom_put( "sss"    , tsn(:,:,1,jp_sal)                     )    ! sea surface salinity 
     141      CALL iom_put( "sss2"   , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) )    ! square of sea surface salinity 
     142      CALL iom_put( "uoce"   , un                                    )    ! i-current       
     143      CALL iom_put( "voce"   , vn                                    )    ! j-current 
    147144       
    148       CALL iom_put( "avt"    , avt                   )    ! T vert. eddy diff. coef. 
    149       CALL iom_put( "avm"    , avmu                  )    ! T vert. eddy visc. coef. 
     145      CALL iom_put( "avt"    , avt                                   )    ! T vert. eddy diff. coef. 
     146      CALL iom_put( "avm"    , avmu                                  )    ! T vert. eddy visc. coef. 
    150147      IF( lk_zdfddm ) THEN 
    151          CALL iom_put( "avs" , fsavs(:,:,:)          )    ! S vert. eddy diff. coef. 
     148         CALL iom_put( "avs" , fsavs(:,:,:)                          )    ! S vert. eddy diff. coef. 
    152149      ENDIF 
    153150 
    154151      DO jj = 2, jpjm1                                    ! sst gradient 
    155152         DO ji = fs_2, fs_jpim1   ! vector opt. 
    156             zztmp      = tn(ji,jj,1) 
    157             zztmpx     = ( tn(ji+1,jj  ,1) - zztmp ) / e1u(ji,jj) + ( zztmp - tn(ji-1,jj  ,1) ) / e1u(ji-1,jj  ) 
    158             zztmpy     = ( tn(ji  ,jj+1,1) - zztmp ) / e2v(ji,jj) + ( zztmp - tn(ji  ,jj-1,1) ) / e2v(ji  ,jj-1) 
     153            zztmp      = tsn(ji,jj,1,jp_tem) 
     154            zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  ) 
     155            zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1) 
    159156            z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    160157               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    … …  
    178175            DO jj = 2, jpjm1 
    179176               DO ji = fs_2, fs_jpim1   ! vector opt. 
    180                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
     177                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    181178               END DO 
    182179            END DO 
    … …  
    192189            DO jj = 2, jpjm1 
    193190               DO ji = fs_2, fs_jpim1   ! vector opt. 
    194                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) 
     191                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    195192               END DO 
    196193            END DO 
    … …  
    200197      ENDIF 
    201198      ! 
    202       IF( wrk_not_released(2, 1))THEN 
     199      IF( wrk_not_released(3, 1) .OR. wrk_not_released(2, 1) ) THEN 
    203200         CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.') 
    204201         RETURN 
    … …  
    516513 
    517514      ! Write fields on T grid 
    518       CALL histwrite( nid_T, "votemper", it, tn            , ndim_T , ndex_T  )   ! temperature 
    519       CALL histwrite( nid_T, "vosaline", it, sn            , ndim_T , ndex_T  )   ! salinity 
    520       CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface temperature 
    521       CALL histwrite( nid_T, "sosaline", it, sn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface salinity 
     515      CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem), ndim_T , ndex_T  )   ! temperature 
     516      CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal), ndim_T , ndex_T  )   ! salinity 
     517      CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem), ndim_hT, ndex_hT )   ! sea surface temperature 
     518      CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal), ndim_hT, ndex_hT )   ! sea surface salinity 
    522519      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height 
    523520!!$#if  defined key_lim3 || defined key_lim2  
    … …  
    528525!!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff 
    529526      CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux 
    530       zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * sn(:,:,1) * tmask(:,:,1) 
     527      zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    531528      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux 
    532529      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux 
    … …  
    539536      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    540537      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    541       IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1) 
     538      IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    542539      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    543540#endif 
    … …  
    545542      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    546543      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    547          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1) 
     544         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    548545      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    549546#endif 
    … …  
    711708 
    712709      ! Write all fields on T grid 
    713       CALL histwrite( id_i, "votemper", kt, tn      , jpi*jpj*jpk, idex )    ! now temperature 
    714       CALL histwrite( id_i, "vosaline", kt, sn      , jpi*jpj*jpk, idex )    ! now salinity 
    715       CALL histwrite( id_i, "sossheig", kt, sshn     , jpi*jpj    , idex )    ! sea surface height 
    716       CALL histwrite( id_i, "vozocrtx", kt, un       , jpi*jpj*jpk, idex )    ! now i-velocity 
    717       CALL histwrite( id_i, "vomecrty", kt, vn       , jpi*jpj*jpk, idex )    ! now j-velocity 
    718       CALL histwrite( id_i, "vovecrtz", kt, wn       , jpi*jpj*jpk, idex )    ! now k-velocity 
    719       CALL histwrite( id_i, "sowaflup", kt, (emp-rnf), jpi*jpj    , idex )    ! freshwater budget 
    720       CALL histwrite( id_i, "sohefldo", kt, qsr + qns, jpi*jpj    , idex )    ! total heat flux 
    721       CALL histwrite( id_i, "soshfldo", kt, qsr      , jpi*jpj    , idex )    ! solar heat flux 
    722       CALL histwrite( id_i, "soicecov", kt, fr_i     , jpi*jpj    , idex )    ! ice fraction 
    723       CALL histwrite( id_i, "sozotaux", kt, utau     , jpi*jpj    , idex )    ! i-wind stress 
    724       CALL histwrite( id_i, "sometauy", kt, vtau     , jpi*jpj    , idex )    ! j-wind stress 
     710      CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature 
     711      CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity 
     712      CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height 
     713      CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity 
     714      CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
     715      CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
     716      CALL histwrite( id_i, "sowaflup", kt, (emp-rnf )       , jpi*jpj    , idex )    ! freshwater budget 
     717      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
     718      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
     719      CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction 
     720      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
     721      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
    725722 
    726723      ! 3. Close the file 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r2715 r2977  
    152152       wm(:,:,:)=wm(:,:,:) + wn (:,:,:) 
    153153       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:) 
    154        tm(:,:,:)=tm(:,:,:) + tn (:,:,:) 
    155        sm(:,:,:)=sm(:,:,:) + sn (:,:,:) 
     154       tm(:,:,:)=tm(:,:,:) + tsn(:,:,:,jp_tem) 
     155       sm(:,:,:)=sm(:,:,:) + tsn(:,:,:,jp_sal) 
    156156       ! 
    157157       fsel(:,:,1 ) = fsel(:,:,1 ) + utau(:,:) * umask(:,:,1) 
    … …  
    159159       fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:)  
    160160       fsel(:,:,4 ) = fsel(:,:,4 ) + ( emp(:,:)-rnf(:,:) )  
    161        !        fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1)  !RB not used 
     161       !        fsel(:,:,5 ) = fsel(:,:,5 ) + tsb(:,:,1,jp_tem)  !RB not used 
    162162       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)  
    163163       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:) 
    … …  
    226226          fsel(:,:,3 ) = (qsr (:,:) + qns (:,:)) * tmask(:,:,1) 
    227227          fsel(:,:,4 ) = ( emp(:,:)-rnf(:,:) ) * tmask(:,:,1)  
    228           !         fsel(:,:,5 ) = (tb  (:,:,1) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used 
     228          !         fsel(:,:,5 ) = (tsb(:,:,1,jp_tem) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used 
    229229 
    230230          fsel(:,:,6 ) = sshn(:,:) 
    … …  
    302302 
    303303       IF( ll_dia_inst) THEN 
    304           CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T') 
    305        ELSE 
    306           CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T') 
     304          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_tem), jpk, 'T') 
     305       ELSE 
     306          CALL dia_wri_dimg(clname, cltext, tm               , jpk, 'T') 
    307307       ENDIF 
    308308       ! 
    … …  
    314314 
    315315       IF( ll_dia_inst) THEN 
    316           CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T') 
    317        ELSE 
    318           CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T') 
     316          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_sal), jpk, 'T') 
     317       ELSE 
     318          CALL dia_wri_dimg(clname, cltext, sm               , jpk, 'T') 
    319319       ENDIF 
    320320       ! 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r2777 r2977  
    1313   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom 
    1414   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA 
     15   !!            3.4  !  2011-04  (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn  
    1516   !!---------------------------------------------------------------------- 
    1617 
    … …  
    3031   USE zdf_oce         ! ocean vertical physics 
    3132   USE phycst          ! physical constants 
    32    USE dtatem          ! temperature data                 (dta_tem routine) 
    33    USE dtasal          ! salinity data                    (dta_sal routine) 
     33   USE dtatsd          ! data temperature and salinity   (dta_tsd routine) 
    3434   USE restart         ! ocean restart                   (rst_read routine) 
    3535   USE in_out_manager  ! I/O manager 
    … …  
    4242   USE dynspg_exp      ! pressure gradient schemes 
    4343   USE dynspg_ts       ! pressure gradient schemes 
    44    USE traswp          ! Swap arrays                      (tra_swp routine) 
    4544   USE lib_mpp         ! MPP library 
    4645 
    … …  
    7372      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    7473 
    75       rhd  (:,:,:) = 0.e0 
    76       rhop (:,:,:) = 0.e0 
    77       rn2  (:,:,:) = 0.e0  
    78       ta   (:,:,:) = 0.e0     
    79       sa   (:,:,:) = 0.e0 
     74      CALL dta_tsd_init                       ! Initialisation of T & S input data 
     75 
     76      rhd  (:,:,:  ) = 0.e0 
     77      rhop (:,:,:  ) = 0.e0 
     78      rn2  (:,:,:  ) = 0.e0  
     79      tsa  (:,:,:,:) = 0.e0     
    8080 
    8181      IF( ln_rstart ) THEN                    ! Restart from a file 
    … …  
    8383         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog) 
    8484         CALL rst_read                           ! Read the restart file 
    85          CALL tra_swap                           ! swap 3D arrays (t,s)  in a 4D array (ts) 
    8685         CALL day_init                           ! model calendar (using both namelist and restart infos) 
    8786      ELSE 
    … …  
    9998         hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0 
    10099         ! 
    101          IF( cp_cfg == 'eel' ) THEN 
     100         IF( cp_cfg == 'eel'      ) THEN 
    102101            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields 
    103102         ELSEIF( cp_cfg == 'gyre' ) THEN          
    104103            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields 
    105          ELSE 
    106             !                                    ! Other configurations: Initial T-S fields 
    107 #if defined key_dtatem 
    108             CALL dta_tem( nit000 )                  ! read 3D temperature data 
    109             tb(:,:,:) = t_dta(:,:,:)   ;   tn(:,:,:) = t_dta(:,:,:) 
    110              
    111 #else 
    112             IF(lwp) WRITE(numout,*)                 ! analytical temperature profile 
    113             IF(lwp) WRITE(numout,*)'             Temperature initialization using an analytic profile' 
    114             CALL istate_tem 
    115 #endif 
    116 #if defined key_dtasal 
    117             CALL dta_sal( nit000 )                  ! read 3D salinity data 
    118             sb(:,:,:) = s_dta(:,:,:)   ;   sn(:,:,:) = s_dta(:,:,:) 
    119 #else 
    120             ! No salinity data 
    121             IF(lwp)WRITE(numout,*)                  ! analytical salinity profile 
    122             IF(lwp)WRITE(numout,*)'             Salinity initialisation using a constant value' 
    123             CALL istate_sal 
    124 #endif 
     104         ELSEIF( ln_tsd_init      ) THEN         ! Initial T-S fields read in files 
     105            CALL dta_tsd( nit000, tsb )                  ! read 3D T and S data at nit000 
     106            tsn(:,:,:,:) = tsb(:,:,:,:) 
     107            ! 
     108         ELSE                                    ! Initial T-S fields defined analytically 
     109            CALL istate_t_s 
    125110         ENDIF 
    126111         ! 
    127          CALL tra_swap                     ! swap 3D arrays (tb,sb,tn,sn)  in a 4D array 
    128112         CALL eos( tsb, rhd, rhop )        ! before potential and in situ densities 
    129113#if ! defined key_c1d 
    … …  
    150134   END SUBROUTINE istate_init 
    151135 
    152  
    153    SUBROUTINE istate_tem 
     136   SUBROUTINE istate_t_s 
    154137      !!--------------------------------------------------------------------- 
    155       !!                  ***  ROUTINE istate_tem  *** 
     138      !!                  ***  ROUTINE istate_t_s  *** 
    156139      !!    
    157140      !! ** Purpose :   Intialization of the temperature field with an  
    158141      !!      analytical profile or a file (i.e. in EEL configuration) 
    159142      !! 
    160       !! ** Method  :   Use Philander analytic profile of temperature 
     143      !! ** Method  : - temperature: use Philander analytic profile 
     144      !!              - salinity   : use to a constant value 35.5 
    161145      !! 
    162146      !! References :  Philander ??? 
    163147      !!---------------------------------------------------------------------- 
    164       INTEGER :: ji, jj, jk 
     148      INTEGER  :: ji, jj, jk 
     149      REAL(wp) ::   zsal = 35.50 
    165150      !!---------------------------------------------------------------------- 
    166151      ! 
    167152      IF(lwp) WRITE(numout,*) 
    168       IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile' 
    169       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     153      IF(lwp) WRITE(numout,*) 'istate_t_s : Philander s initial temperature profile' 
     154      IF(lwp) WRITE(numout,*) '~~~~~~~~~~   and constant salinity (',zsal,' psu)' 
    170155      ! 
    171156      DO jk = 1, jpk 
    172          DO jj = 1, jpj 
    173             DO ji = 1, jpi 
    174                tn(ji,jj,jk) = (  ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. )   & 
    175                   &               *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) )   & 
    176                   &            + 10.*(5000.-fsdept(ji,jj,jk))/5000.)  ) * tmask(ji,jj,jk) 
    177                tb(ji,jj,jk) = tn(ji,jj,jk) 
    178           END DO 
    179         END DO 
     157         tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((fsdept(:,:,jk)-80.)/30.) )   & 
     158            &                + 10. * ( 5000. - fsdept(:,:,jk) ) /5000.)  ) * tmask(:,:,jk) 
     159         tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 
    180160      END DO 
    181       ! 
    182       IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    183          &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    184          &                 1     , 1.    , numout                  ) 
    185       ! 
    186    END SUBROUTINE istate_tem 
    187  
    188  
    189    SUBROUTINE istate_sal 
    190       !!--------------------------------------------------------------------- 
    191       !!                  ***  ROUTINE istate_sal  *** 
    192       !! 
    193       !! ** Purpose :   Intialize the salinity field with an analytic profile 
    194       !! 
    195       !! ** Method  :   Use to a constant value 35.5 
    196       !!               
    197       !! ** Action  :   Initialize sn and sb 
    198       !!---------------------------------------------------------------------- 
    199       REAL(wp) ::   zsal = 35.50_wp 
    200       !!---------------------------------------------------------------------- 
    201       ! 
    202       IF(lwp) WRITE(numout,*) 
    203       IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal 
    204       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    205       ! 
    206       sn(:,:,:) = zsal * tmask(:,:,:) 
    207       sb(:,:,:) = sn(:,:,:) 
    208       ! 
    209    END SUBROUTINE istate_sal 
     161      tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
     162      tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
     163      ! 
     164   END SUBROUTINE istate_t_s 
    210165 
    211166 
    … …  
    254209            ! 
    255210            DO jk = 1, jpk 
    256                tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 
    257                tb(:,:,jk) = tn(:,:,jk) 
     211               tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 
     212               tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 
    258213            END DO 
    259214            ! 
    260             IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    261                &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    262                &                 1     , 1.    , numout                  ) 
     215            IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   & 
     216               &                             1     , jpi   , 5     , 1     , jpk   ,   & 
     217               &                             1     , 1.    , numout                  ) 
    263218            ! 
    264219            ! set salinity field to a constant value 
    … …  
    268223            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    269224            ! 
    270             sn(:,:,:) = zsal * tmask(:,:,:) 
    271             sb(:,:,:) = sn(:,:,:) 
     225            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
     226            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    272227            ! 
    273228            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary) 
    … …  
    323278            ! 
    324279            CALL iom_open ( 'eel.initemp', inum ) 
    325             CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb) 
     280            CALL iom_get ( inum, jpdom_data, 'initemp', tsb(:,:,:,jp_tem) ) ! read before temprature (tb) 
    326281            CALL iom_close( inum ) 
    327282            ! 
    328             tn(:,:,:) = tb(:,:,:)                            ! set nox temperature to tb 
    329             ! 
    330             IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    331                &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    332                &                 1     , 1.    , numout                  ) 
     283            tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem)                            ! set nox temperature to tb 
     284            ! 
     285            IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   & 
     286               &                            1     , jpi   , 5     , 1     , jpk   ,   & 
     287               &                            1     , 1.    , numout                  ) 
    333288            ! 
    334289            ! set salinity field to a constant value 
    … …  
    338293            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    339294            ! 
    340             sn(:,:,:) = zsal * tmask(:,:,:) 
    341             sb(:,:,:) = sn(:,:,:) 
     295            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
     296            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    342297            ! 
    343298            !                                    ! =========================== 
    … …  
    377332            DO jj = 1, jpj 
    378333               DO ji = 1, jpi 
    379                   tn(ji,jj,jk) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   & 
     334                  tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   & 
    380335                       &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               & 
    381336                       &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       & 
    … …  
    383338                       &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   &  
    384339                       &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
    385                   tn(ji,jj,jk) = tn(ji,jj,jk) * tmask(ji,jj,jk) 
    386                   tb(ji,jj,jk) = tn(ji,jj,jk) 
    387  
    388                   sn(ji,jj,jk) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  & 
     340                  tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     341                  tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) 
     342 
     343                  tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  & 
    389344                     &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          & 
    390345                     &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         & 
    … …  
    393348                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  & 
    394349                     &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2  
    395                   sn(ji,jj,jk) = sn(ji,jj,jk) * tmask(ji,jj,jk) 
    396                   sb(ji,jj,jk) = sn(ji,jj,jk) 
     350                  tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     351                  tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) 
    397352               END DO 
    398353            END DO 
    … …  
    408363         ! ---------------------- 
    409364         CALL iom_open ( 'data_tem', inum ) 
    410          CALL iom_get ( inum, jpdom_data, 'votemper', tn )  
     365         CALL iom_get ( inum, jpdom_data, 'votemper', tsn(:,:,:,jp_tem) )  
    411366         CALL iom_close( inum ) 
    412367 
    413          tn(:,:,:) = tn(:,:,:) * tmask(:,:,:)  
    414          tb(:,:,:) = tn(:,:,:) 
     368         tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)  
     369         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 
    415370 
    416371         ! Read salinity field 
    417372         ! ------------------- 
    418373         CALL iom_open ( 'data_sal', inum ) 
    419          CALL iom_get ( inum, jpdom_data, 'vosaline', sn )  
     374         CALL iom_get ( inum, jpdom_data, 'vosaline', tsn(:,:,:,jp_sal) )  
    420375         CALL iom_close( inum ) 
    421376 
    422          sn(:,:,:)  = sn(:,:,:) * tmask(:,:,:)  
    423          sb(:,:,:)  = sn(:,:,:) 
     377         tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)  
     378         tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    424379 
    425380      END SELECT 
    … …  
    429384         WRITE(numout,*) '              Initial temperature and salinity profiles:' 
    430385         WRITE(numout, "(9x,' level   gdept_0   temperature   salinity   ')" ) 
    431          WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tn(2,2,jk), sn(2,2,jk), jk = 1, jpk ) 
     386         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk ) 
    432387      ENDIF 
    433388 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r2715 r2977  
    4848      !!---------------------------------------------------------------------- 
    4949      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    50       USE oce     , ONLY:   zfu   => ta       , zfv   => sa       ! (ta,sa) used as 3D workspace 
     50      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    5151      USE wrk_nemo, ONLY:   zfu_t => wrk_3d_1 , zfv_t => wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspaces 
    5252      USE wrk_nemo, ONLY:   zfu_f => wrk_3d_2 , zfv_f => wrk_3d_5 , zfv_vw =>wrk_3d_7 
    53       USE wrk_nemo, ONLY:   zfw   => wrk_3d_3  
     53      USE wrk_nemo, ONLY:   zfw   => wrk_3d_3 
    5454      ! 
    5555      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    … …  
    5757      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    5858      REAL(wp) ::   zbu, zbv     ! local scalars 
     59      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv 
    5960      !!---------------------------------------------------------------------- 
    6061 
    … …  
    6970         CALL ctl_stop('dyn_adv_cen2 : requested workspace array unavailable')   ;   RETURN 
    7071      ENDIF 
    71  
     72      ! 
     73      zfu => tsa(:,:,:,1)  
     74      zfv => tsa(:,:,:,2)  
     75      ! 
    7276      IF( l_trddyn ) THEN           ! Save ua and va trends 
    7377         zfu_uw(:,:,:) = ua(:,:,:) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r2715 r2977  
    6969      !!---------------------------------------------------------------------- 
    7070      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    71       USE oce     , ONLY:   zfu    => ta       , zfv    => sa      ! (ta,sa) used as 3D workspace 
     71      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    7272      USE wrk_nemo, ONLY:   zfu_t  => wrk_3d_1 , zfv_t  =>wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspace 
    7373      USE wrk_nemo, ONLY:   zfu_f  => wrk_3d_2 , zfv_f  =>wrk_3d_5 , zfv_vw =>wrk_3d_7 
    … …  
    8181      REAL(wp) ::   zbu, zbv    ! temporary scalars 
    8282      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary scalars 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv 
    8384      !!---------------------------------------------------------------------- 
    8485 
    … …  
    9394         CALL ctl_stop('dyn_adv_ubs: requested workspace array unavailable')   ;   RETURN 
    9495      ENDIF 
    95  
     96      ! 
     97      zfu => tsa(:,:,:,1)  
     98      zfv => tsa(:,:,:,2)  
     99      ! 
    96100      zfu_t(:,:,:) = 0._wp 
    97101      zfv_t(:,:,:) = 0._wp 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2715 r2977  
    7777      !!             - Save the trend (l_trddyn=T) 
    7878      !!---------------------------------------------------------------------- 
    79       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2   ! 3D workspace 
     79      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    8180      !! 
    8281      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    83       !!---------------------------------------------------------------------- 
    84       ! 
    85       IF( wrk_in_use(3, 1,2) ) THEN 
    86          CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable')   ;   RETURN 
    87       ENDIF 
     82      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     83      !!---------------------------------------------------------------------- 
    8884      ! 
    8985      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
     86         ztrdu => tsa(:,:,:,1)  
     87         ztrdv => tsa(:,:,:,2)  
     88         ! 
    9089         ztrdu(:,:,:) = ua(:,:,:)   
    9190         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    110109      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    111110         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    112       ! 
    113       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_hpg: failed to release workspace arrays') 
    114111      ! 
    115112   END SUBROUTINE dyn_hpg 
    … …  
    193190      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    194191      !!---------------------------------------------------------------------- 
    195       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     192      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    196193      !! 
    197194      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    199196      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    200197      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
     198      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    201199      !!---------------------------------------------------------------------- 
    202200       
     201      zhpi => tsa(:,:,:,1)  
     202      zhpj => tsa(:,:,:,2)  
     203      ! 
    203204      IF( kt == nit000 ) THEN 
    204205         IF(lwp) WRITE(numout,*) 
    … …  
    221222         END DO 
    222223      END DO 
     224 
    223225      ! 
    224226      ! interior value (2=<jk=<jpkm1) 
    … …  
    253255      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend 
    254256      !!----------------------------------------------------------------------  
    255       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     257      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    256258      !! 
    257259      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    260262      INTEGER  ::   iku, ikv                         ! temporary integers 
    261263      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    262       !!---------------------------------------------------------------------- 
    263  
     264      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     265      !!---------------------------------------------------------------------- 
     266        
     267      zhpi => tsa(:,:,:,1)  
     268      zhpj => tsa(:,:,:,2)  
     269      ! 
    264270      IF( kt == nit000 ) THEN 
    265271         IF(lwp) WRITE(numout,*) 
    … …  
    267273         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization' 
    268274      ENDIF 
     275 
    269276 
    270277      ! Local constant initialization 
    … …  
    284291      END DO 
    285292 
     293 
    286294      ! interior value (2=<jk=<jpkm1) 
    287295      DO jk = 2, jpkm1 
    … …  
    303311         END DO 
    304312      END DO 
     313 
    305314 
    306315      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90) 
    … …  
    333342      END DO 
    334343      ! 
     344 
    335345   END SUBROUTINE hpg_zps 
    336346 
    … …  
    354364      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    355365      !!---------------------------------------------------------------------- 
    356       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     366      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    357367      !! 
    358368      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    360370      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    361371      REAL(wp) ::   zcoef0, zuap, zvap, znad   ! temporary scalars 
    362       !!---------------------------------------------------------------------- 
    363  
     372      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     373      !!---------------------------------------------------------------------- 
     374 
     375      zhpi => tsa(:,:,:,1)  
     376      zhpj => tsa(:,:,:,2)  
     377      ! 
    364378      IF( kt == nit000 ) THEN 
    365379         IF(lwp) WRITE(numout,*) 
    … …  
    439453      !!             - Save the trend (l_trddyn=T) 
    440454      !!---------------------------------------------------------------------- 
    441       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     455      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    442456      !! 
    443457      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    445459      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    446460      REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    447       !!---------------------------------------------------------------------- 
    448  
     461      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     462      !!---------------------------------------------------------------------- 
     463 
     464      zhpi => tsa(:,:,:,1)  
     465      zhpj => tsa(:,:,:,2)  
     466      ! 
    449467      IF( kt == nit000 ) THEN 
    450468         IF(lwp) WRITE(numout,*) 
    … …  
    515533      !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998. 
    516534      !!---------------------------------------------------------------------- 
    517       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     535      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    518536      !! 
    519537      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    522540      REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    523541      REAL(wp) ::   zalph , zbeta        !    "         " 
    524       !!---------------------------------------------------------------------- 
    525  
     542      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     543      !!---------------------------------------------------------------------- 
     544      ! 
     545      zhpi => tsa(:,:,:,1)  
     546      zhpj => tsa(:,:,:,2)  
     547      ! 
    526548      IF( kt == nit000 ) THEN 
    527549         IF(lwp) WRITE(numout,*) 
    … …  
    595617      !!---------------------------------------------------------------------- 
    596618      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    597       USE oce     , ONLY:   zhpi  => ta        , zhpj => sa       ! (ta,sa) used as 3D workspace 
     619      USE oce     , ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    598620      USE wrk_nemo, ONLY:   drhox => wrk_3d_1  , dzx  => wrk_3d_2 
    599621      USE wrk_nemo, ONLY:   drhou => wrk_3d_3  , dzu  => wrk_3d_4 , rho_i => wrk_3d_5 
    … …  
    610632      REAL(wp) ::   z1_10, cffu, cffx   !    "         " 
    611633      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
     634      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    612635      !!---------------------------------------------------------------------- 
    613636 
    … …  
    615638         CALL ctl_stop('dyn:hpg_djc: requested workspace arrays unavailable')   ;   RETURN 
    616639      ENDIF 
     640      ! 
     641      zhpi => tsa(:,:,:,1)  
     642      zhpj => tsa(:,:,:,2)  
    617643 
    618644      IF( kt == nit000 ) THEN 
    … …  
    826852      !!---------------------------------------------------------------------- 
    827853      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    828       USE oce     , ONLY:   zhpi    => ta       , zhpj    => sa       ! (ta,sa) used as 3D workspace 
     854      USE oce     , ONLY:   tsa                          ! (tsa) used as 2 3D workspace 
    829855      USE wrk_nemo, ONLY:   zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
    830856      USE wrk_nemo, ONLY:   zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
    … …  
    838864      REAL(wp) ::   zforg, zcoef0, zuap, zmskd1, zmskd1m   ! temporary scalar 
    839865      REAL(wp) ::   zfrot        , zvap, zmskd2, zmskd2m   !    "         " 
     866      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    840867      !!---------------------------------------------------------------------- 
    841868 
    … …  
    844871         CALL ctl_stop('dyn:hpg_rot: requested workspace arrays unavailable')   ;   RETURN 
    845872      ENDIF 
     873      ! 
     874      zhpi => tsa(:,:,:,1)  
     875      zhpj => tsa(:,:,:,2)  
    846876 
    847877      IF( kt == nit000 ) THEN 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r2777 r2977  
    5353      !!---------------------------------------------------------------------- 
    5454      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    55       USE oce     , ONLY:   ztrdu => ta       , ztrdv => sa   ! (ta,sa) used as 3D workspace    
     55      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    5656      USE wrk_nemo, ONLY:   zhke  => wrk_3d_1                 ! 3D workspace 
    5757      !! 
    … …  
    6060      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6161      REAL(wp) ::   zu, zv       ! temporary scalars 
     62      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdu, ztrdv  
    6263      !!---------------------------------------------------------------------- 
    6364 
    … …  
    7374 
    7475      IF( l_trddyn ) THEN           ! Save ua and va trends 
     76         ztrdu => tsa(:,:,:,1)  
     77         ztrdv => tsa(:,:,:,2)  
     78         ! 
    7579         ztrdu(:,:,:) = ua(:,:,:)  
    7680         ztrdv(:,:,:) = va(:,:,:)  

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r2715 r2977  
    8686      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    8787      USE wrk_nemo, ONLY:   zwk1 => wrk_3d_3 , zwk2 => wrk_3d_4   ! 3D workspace 
    88       USE oce     , ONLY:   zwk3 => ta       , zwk4 => sa         ! ta, sa used as 3D workspace    
     88      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    8989      ! 
    9090      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    9191      ! 
    9292      INTEGER ::   ji, jj, jk                 ! dummy loop indices 
     93      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwk3, zwk4 
    9394      !!---------------------------------------------------------------------- 
    9495 
    … …  
    9697         CALL ctl_stop('dyn_ldf_bilapg: requested workspace arrays unavailable')   ;   RETURN 
    9798      ENDIF 
    98  
     99      ! 
     100      zwk3 => tsa(:,:,:,1)  
     101      zwk4 => tsa(:,:,:,2)  
     102      ! 
    99103      IF( kt == nit000 ) THEN 
    100104         IF(lwp) WRITE(numout,*) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2779 r2977  
    9393      !!---------------------------------------------------------------------- 
    9494      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    95       USE oce     , ONLY:   ze3u_f => ta       , ze3v_f => sa       ! (ta,sa) used as 3D workspace 
     95      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    9696      USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3 
    9797      ! 
    … …  
    105105      REAL(wp) ::   zve3a, zve3n, zve3b, zvf    !   -      - 
    106106      REAL(wp) ::   zec, zv_t_ij, zv_t_ip1j, zv_t_ijp1 
     107      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f  
    107108      !!---------------------------------------------------------------------- 
    108109 
    … …  
    110111         CALL ctl_stop('dyn_nxt: requested workspace arrays unavailable')   ;   RETURN 
    111112      ENDIF 
    112  
     113      ! 
     114      ze3u_f => tsa(:,:,:,1)  
     115      ze3v_f => tsa(:,:,:,2)  
     116      ! 
    113117      IF( kt == nit000 ) THEN 
    114118         IF(lwp) WRITE(numout,*) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2715 r2977  
    103103      !! References : Roullet and Madec 1999, JGR. 
    104104      !!--------------------------------------------------------------------- 
    105       USE oce, ONLY:   zub   => ta , zvb   => sa   ! (ta,sa) used as workspace 
     105      USE oce, ONLY:   tsa                 ! tsa used as 2 3D workspace 
    106106      !! 
    107107      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    … …  
    110110      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    111111      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars 
     112      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zub, zvb 
    112113      !!---------------------------------------------------------------------- 
     114      ! 
     115      zub => tsa(:,:,:,1)  
     116      zvb => tsa(:,:,:,2)  
    113117      ! 
    114118      IF( kt == nit000 ) THEN 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r2715 r2977  
    7171      !!               and planetary vorticity trends) ('key_trddyn') 
    7272      !!---------------------------------------------------------------------- 
    73       USE oce, ONLY:   ztrdu => ta , ztrdv => sa   ! (ta,sa) used as 3D workspace 
    74       ! 
     73      USE oce, ONLY:   tsa            ! tsa used as 2 3D workspace 
     74      !! 
    7575      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    76       !!---------------------------------------------------------------------- 
     76      ! 
     77      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     78      !!---------------------------------------------------------------------- 
     79      ! 
     80      IF( l_trddyn )   THEN 
     81         ztrdu => tsa(:,:,:,1)  
     82         ztrdv => tsa(:,:,:,2)  
     83      END IF 
    7784      ! 
    7885      !                                          ! vorticity term  

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r2715 r2977  
    5252      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends 
    5353      !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
    54      !!---------------------------------------------------------------------- 
    55       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     54      !!---------------------------------------------------------------------- 
     55      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    5656      USE wrk_nemo, ONLY:   zww   => wrk_2d_1                        ! 2D workspace 
    57       USE oce     , ONLY:   zwuw  => ta       , zwvw  => sa          ! (ta,sa) used as 3D workspace 
     57      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    5858      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace 
    59       ! 
     59      !! 
    6060      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    6161      ! 
    6262      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    6363      REAL(wp) ::   zua, zva        ! temporary scalars 
     64      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwuw , zwvw 
    6465      !!---------------------------------------------------------------------- 
    6566       
    66       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN 
     67      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN  
    6768         CALL ctl_stop('dyn_zad: requested workspace arrays unavailable')   ;   RETURN 
    6869      ENDIF 
    69  
     70      ! 
     71      zwuw  => tsa(:,:,:,1)  
     72      zwvw  => tsa(:,:,:,2)  
     73      ! 
    7074      IF( kt == nit000 ) THEN 
    7175         IF(lwp)WRITE(numout,*) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r2715 r2977  
    5555      !!--------------------------------------------------------------------- 
    5656      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    57       USE oce     , ONLY:   zwx => ta       , zwy => sa         ! (ta,sa) used as 3D workspace 
    58       USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zww => wrk_3d_2   ! 3D workspace 
     57      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
     58      USE wrk_nemo, ONLY:   zwz => wrk_3d_3 , zww => wrk_3d_4   ! 3D workspace 
    5959      ! 
    6060      INTEGER , INTENT(in) ::   kt     ! ocean time-step index 
    … …  
    6363      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    6464      REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars 
     65      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy 
    6566      !!---------------------------------------------------------------------- 
    6667 
    67       IF( wrk_in_use(3, 1,2) ) THEN 
     68      IF( wrk_in_use(3, 3,4) ) THEN 
    6869         CALL ctl_stop('dyn_zdf_exp: requested workspace arrays unavailable')   ;   RETURN 
    6970      ENDIF 
    70  
     71      ! 
     72      zwx => tsa(:,:,:,1)  
     73      zwy => tsa(:,:,:,2)  
     74      ! 
    7175      IF( kt == nit000 .AND. lwp ) THEN 
    7276         WRITE(numout,*) 
    … …  
    120124      END DO                           ! End of time splitting 
    121125      ! 
    122       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf_exp: failed to release workspace arrays') 
     126      IF( wrk_not_released(3, 3,4) )   CALL ctl_stop('dyn_zdf_exp: failed to release workspace arrays') 
    123127      ! 
    124128   END SUBROUTINE dyn_zdf_exp 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r2715 r2977  
    5555      !!--------------------------------------------------------------------- 
    5656      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    57       USE oce     , ONLY:  zwd  => ta       , zws   => sa   ! (ta,sa) used as 3D workspace 
     57      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    5858      USE wrk_nemo, ONLY:   zwi => wrk_3d_3                 ! 3D workspace 
    5959      !! 
    … …  
    6363      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6464      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars 
     65      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwd, zws 
    6566      !!---------------------------------------------------------------------- 
    6667 
    … …  
    6869         CALL ctl_stop('dyn_zdf_imp: requested workspace array unavailable')   ;   RETURN 
    6970      END IF 
    70  
     71      ! 
     72      zwd => tsa(:,:,:,1)  
     73      zws => tsa(:,:,:,2)  
     74      ! 
    7175      IF( kt == nit000 ) THEN 
    7276         IF(lwp) WRITE(numout,*) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2715 r2977  
    7575      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    7676      !!---------------------------------------------------------------------- 
    77       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    78       USE oce     , ONLY:   z3d   => ta                           ! ta used as 3D workspace 
    79       USE wrk_nemo, ONLY:   zhdiv => wrk_2d_1 , z2d => wrk_2d_2   ! 2D workspace 
    80       ! 
     77      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     78      USE oce     , ONLY: tsa             ! tsa used as 2 3D workspace 
     79      USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, z2d => wrk_2d_2 
     80      !! 
    8181      INTEGER, INTENT(in) ::   kt   ! time step 
    8282      ! 
    8383      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    8484      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars 
     85      REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d 
    8586      !!---------------------------------------------------------------------- 
    8687 
    … …  
    230231      IF( lk_diaar5 ) THEN                            ! vertical mass transport & its square value 
    231232         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
     233         z3d => tsa(:,:,:,1) 
    232234         z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 
    233235         DO jk = 1, jpk 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    r2715 r2977  
    127127                  ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    128128                  ! We save  the instantaneous profile of T and S of the column      
    129                   ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    130                   ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    131                   ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    132                   zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)             
     129                  ! ztemp(jfl)=tsn(iafloc,ibfloc,icfl,jp_tem) 
     130                  ! zsal(jfl)=tsn(iafloc,ibfloc,icfl,jp_sal) 
     131                  ztemp(1:jpk,jfl) = tsn(iafloc,ibfloc,1:jpk,jp_tem) 
     132                  zsal (1:jpk,jfl) = tsn(iafloc,ibfloc,1:jpk,jp_sal)             
    133133               ELSE 
    134134                  flxx(jfl) = 0. 
    … …  
    187187               ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    188188               ! We save  the instantaneous profile of T and S of the column      
    189                !     ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    190                !     zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    191                ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    192                zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 
     189               !     ztemp(jfl)=tsn(iafloc,ibfloc,icfl,jp_tem) 
     190               !     zsal(jfl)=tsn(iafloc,ibfloc,icfl,jp_sal) 
     191               ztemp(1:jpk,jfl) = tsn(iafloc,ibfloc,1:jpk,jp_tem) 
     192               zsal (1:jpk,jfl) = tsn(iafloc,ibfloc,1:jpk,jp_sal) 
    193193            END DO 
    194194         ENDIF 
    … …  
    224224      !         ibfloc=ibfln 
    225225      !# endif 
    226       !         ztemp(jfl)=tn(iafloc,ibfloc,jk) 
    227       !         zsal(jfl)=sn(iaflo!,ibfloc,jk) 
     226      !         ztemp(jfl)=tsn(iafloc,ibfloc,jk,jp_tem) 
     227      !         zsal(jfl)=tsn(iaflo!,ibfloc,jk,jp_sal) 
    228228      !# if defined key_mpp_mpi    
    229229      !        ELSE 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r2528 r2977  
    2424   USE trdmld_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE domvvl          ! variable volume 
    26    USE traswp          ! swap from 4D T-S to 3D T & S and vice versa 
    2726 
    2827   IMPLICIT NONE 
    … …  
    117116                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields 
    118117                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        ) 
    119                      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tb        ) 
    120                      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , sb        ) 
     118                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) ) 
     119                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) ) 
    121120                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      ) 
    122121                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     ) 
    … …  
    126125                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
    127126                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        ) 
    128                      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tn        ) 
    129                      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , sn        ) 
     127                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) ) 
     128                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) ) 
    130129                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      ) 
    131130                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     ) 
    … …  
    186185                     CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields 
    187186                     CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      ) 
    188                      CALL iom_get( numror, jpdom_autoglo, 'tb'     , tb      ) 
    189                      CALL iom_get( numror, jpdom_autoglo, 'sb'     , sb      ) 
     187                     CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) ) 
     188                     CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) ) 
    190189                     CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    ) 
    191190                     CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    … …  
    195194                     CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields 
    196195                     CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      ) 
    197                      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tn      ) 
    198                      CALL iom_get( numror, jpdom_autoglo, 'sn'     , sn      ) 
     196                     CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) ) 
     197                     CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) ) 
    199198                     CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    ) 
    200199                     CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   ) 
    … …  
    205204                     CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly 
    206205      ELSE 
    207                      CALL tra_swap 
    208206                     CALL eos( tsn, rhd )   ! compute rhd 
    209207      ENDIF 
    … …  
    211209      ! 
    212210      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    213          tb   (:,:,:) = tn   (:,:,:)                             ! all before fields set to now values 
    214          sb   (:,:,:) = sn   (:,:,:) 
    215          ub   (:,:,:) = un   (:,:,:) 
    216          vb   (:,:,:) = vn   (:,:,:) 
    217          rotb (:,:,:) = rotn (:,:,:) 
    218          hdivb(:,:,:) = hdivn(:,:,:) 
    219          sshb (:,:)   = sshn (:,:) 
     211         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values 
     212         ub   (:,:,:)   = un   (:,:,:) 
     213         vb   (:,:,:)   = vn   (:,:,:) 
     214         rotb (:,:,:)   = rotn (:,:,:) 
     215         hdivb(:,:,:)   = hdivn(:,:,:) 
     216         sshb (:,:)     = sshn (:,:) 
    220217         IF( lk_vvl ) THEN 
    221218            DO jk = 1, jpk 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90

    r2715 r2977  
    387387            DO ji = mi0(161), mi1(161)  
    388388               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden) 
    389                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_161_88_kt(jk) * tn(ji,jj,jk) 
    390                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_161_88_kt(jk) * sn(ji,jj,jk) 
     389                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_tem) 
     390                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_sal) 
    391391               END DO 
    392392            END DO 
    … …  
    395395            DO ji = mi0(161), mi1(161)  
    396396               jk =  21                                 ! deep outflow + recirulation (combined flux) 
    397                ta(ji,jj,jk) = ta(ji,jj,jk) + hdiv_161_88(20) * tn(ji  ,jj+1,20)   &  ! upper recirculation from Gulf of Aden 
    398                   &                        + hdiv_161_88(21) * tn(ji  ,jj+1,21)   &  ! deep  recirculation from Gulf of Aden 
    399                   &                        + hdiv_160_89(16) * tn(ji-1,jj+2,16)      ! deep inflow from Red sea 
    400                sa(ji,jj,jk) = sa(ji,jj,jk) + hdiv_161_88(20) * sn(ji  ,jj+1,20)   & 
    401                   &                        + hdiv_161_88(21) * sn(ji  ,jj+1,21)   & 
    402                   &                        + hdiv_160_89(16) * sn(ji-1,jj+2,16)    
     397               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_tem)   &  ! upper recirculation from Gulf of Aden 
     398                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_tem)   &  ! deep  recirculation from Gulf of Aden 
     399                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_tem)      ! deep inflow from Red sea 
     400               tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_sal)   & 
     401                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_sal)   & 
     402                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_sal)    
    403403            END DO 
    404404         END DO 
    … …  
    406406            DO ji = mi0(160), mi1(160) 
    407407               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden) 
    408                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_160_89_kt(jk) * tn(ji+1,jj-1,jk) 
    409                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_160_89_kt(jk) * sn(ji+1,jj-1,jk) 
    410                END DO 
    411                !                                        ! deep    outflow (from Red sea) 
    412                ta(ji,jj,16) = ta(ji,jj,16) - hdiv_160_89(jk) * tn(ji,jj,jk) 
    413                sa(ji,jj,16) = sa(ji,jj,16) - hdiv_160_89(jk) * sn(ji,jj,jk) 
     408                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_tem) 
     409                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_sal) 
     410               END DO 
     411               !                                  ! deep    outflow (from Red sea) 
     412               tsa(ji,jj,16,jp_tem) = tsa(ji,jj,16,jp_tem) - hdiv_160_89(16) * tsn(ji,jj,16,jp_tem) 
     413               tsa(ji,jj,16,jp_sal) = tsa(ji,jj,16,jp_sal) - hdiv_160_89(16) * tsn(ji,jj,16,jp_sal) 
    414414            END DO 
    415415         END DO 
    … …  
    577577            DO ji = mi0(139), mi1(139)  
    578578               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)    
    579                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_101_kt(jk) * tn(ji,jj,jk) 
    580                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_101_kt(jk) * sn(ji,jj,jk) 
     579                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_tem) 
     580                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_sal) 
    581581               END DO 
    582582            END DO 
    … …  
    586586            DO ji = mi0(139), mi1(139)  
    587587               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0) 
    588                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_102(jk) * tn(ji,jj-1,jk)  ! middle Atlantic recirculation 
    589                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_102(jk) * sn(ji,jj-1,jk) 
     588                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_tem)  ! middle Atlantic recirculation 
     589                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_sal) 
    590590               END DO 
    591591               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0) 
    592592               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0) 
    593                ta(ji,jj,22) = ta(ji,jj,22) + hdiv_141_102(21) * tn(ji+2,jj  ,21)   &  ! deep Med flow   
    594                   &                        + hdiv_139_101(21) * tn(ji  ,jj-1,21)   &  ! upper  Atlantic recirculation   
    595                   &                        + hdiv_139_101(22) * tn(ji  ,jj-1,22)      ! bottom Atlantic recirculation   
    596                sa(ji,jj,22) = sa(ji,jj,22) + hdiv_141_102(21) * sn(ji+2,jj  ,21)   & 
    597                   &                        + hdiv_139_101(21) * sn(ji  ,jj-1,21)   & 
    598                   &                        + hdiv_139_101(22) * sn(ji  ,jj-1,22)  
     593               tsa(ji,jj,22,jp_tem) = tsa(ji,jj,22,jp_tem) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_tem)   &  ! deep Med flow   
     594                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_tem)   &  ! upper  Atlantic recirculation   
     595                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_tem)      ! bottom Atlantic recirculation   
     596               tsa(ji,jj,22,jp_sal) = tsa(ji,jj,22,jp_sal) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_sal)   & 
     597                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_sal)   & 
     598                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_sal)  
    599599            END DO 
    600600         END DO 
    … …  
    602602            DO ji = mi0(141), mi1(141)  
    603603               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea 
    604                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_141_102_kt(jk) * tn(ji-2,jj-1,jk) 
    605                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_141_102_kt(jk) * sn(ji-2,jj-1,jk) 
     604                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_tem) 
     605                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_sal) 
    606606               END DO 
    607607               !                                         ! deeper flow from Med sea to Atlantic 
    608                ta(ji,jj,21) = ta(ji,jj,21) - hdiv_141_102(21) * tn(ji,jj,21) 
    609                sa(ji,jj,21) = sa(ji,jj,21) - hdiv_141_102(21) * sn(ji,jj,21) 
     608               tsa(ji,jj,21,jp_tem) = tsa(ji,jj,21,jp_tem) - hdiv_141_102(21) * tsn(ji,jj,21,jp_tem) 
     609               tsa(ji,jj,21,jp_sal) = tsa(ji,jj,21,jp_sal) - hdiv_141_102(21) * tsn(ji,jj,21,jp_sal) 
    610610            END DO 
    611611         END DO 
    … …  
    707707            DO ji = mi0(172), mi1(172)  
    708708               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0) 
    709                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * tn(ji,jj,jk)  
    710                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * sn(ji,jj,jk)  
     709                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_tem)  
     710                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_sal)  
    711711               END DO 
    712712               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0) 
    713                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * t_171_94_hor(jk) 
    714                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * s_171_94_hor(jk) 
     713                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * t_171_94_hor(jk) 
     714                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * s_171_94_hor(jk) 
    715715               END DO 
    716716            END DO 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r2772 r2977  
    116116      !!---------------------------------------------------------------------- 
    117117      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    118       USE oce     , ONLY:   zgru => ua       , zww => va   ! (ua,va) used as workspace 
    119       USE oce     , ONLY:   zgrv => ta       , zwz => sa   ! (ta,sa) used as workspace 
    120       USE wrk_nemo, ONLY:   zdzr => wrk_3d_1               ! 3D workspace 
     118      USE oce     , ONLY:   zwz => ua       , zww => va   ! (ua,va) used as workspace 
     119      USE oce     , ONLY:   tsa                           ! (tsa) used as workspace 
     120      USE wrk_nemo, ONLY:   zdzr => wrk_3d_1              ! 3D workspace 
    121121      !! 
    122122      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index 
    … …  
    131131      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    132132      REAL(wp) ::   zck, zfk,      zbw             !   -      - 
     133      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv 
    133134      !!---------------------------------------------------------------------- 
    134135 
    … …  
    136137         CALL ctl_stop('ldf_slp: requested workspace arrays are unavailable')   ;   RETURN 
    137138      ENDIF 
     139      ! 
     140      zgru => tsa(:,:,:,1) 
     141      zgrv => tsa(:,:,:,2) 
    138142 
    139143      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    … …  
    379383      ENDIF 
    380384      ! 
    381       IF( wrk_not_released(3, 1) )   CALL ctl_stop('ldf_slp: failed to release workspace arrays') 
     385      IF( wrk_not_released(3, 1) )  CALL ctl_stop('ldf_slp: failed to release workspace arrays.') 
    382386      ! 
    383387   END SUBROUTINE ldf_slp 
    … …  
    399403      !!---------------------------------------------------------------------- 
    400404      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    401       USE oce     , ONLY:   zdit    => ua       , zdis   => va         ! (ua,va) used as workspace 
    402       USE oce     , ONLY:   zdjt    => ta       , zdjs   => sa         ! (ta,sa) used as workspace 
    403       USE wrk_nemo, ONLY:   zdkt    => wrk_3d_2 , zdks   => wrk_3d_3   ! 3D workspace 
    404       USE wrk_nemo, ONLY:   zalpha  => wrk_3d_4 , zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept 
    405405      USE wrk_nemo, ONLY:   z1_mlbw => wrk_2d_1 
    406       ! 
    407       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    408       ! 
    409       INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices 
     406      USE wrk_nemo, ONLY:   zalpha  => wrk_3d_2 , zbeta => wrk_3d_3    ! alpha, beta at T points, at depth fsgdept 
     407      USE wrk_nemo, ONLY:   zdits   => wrk_4d_1 , zdjts => wrk_4d_2, zdkts => wrk_4d_3   ! 4D workspace 
     408      !! 
     409      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
     410      !! 
     411      INTEGER  ::   ji, jj, jk, jn, jl, ip, jp, kp  ! dummy loop indices 
    410412      INTEGER  ::   iku, ikv                                  ! local integer 
    411413      REAL(wp) ::   zfacti, zfactj, zatempw,zatempu,zatempv   ! local scalars 
    … …  
    416418      !!---------------------------------------------------------------------- 
    417419 
    418       IF( wrk_in_use(3, 2,3,4,5) .OR. wrk_in_use(2, 1) )THEN 
    419          CALL ctl_stop('ldf_slp_grif: requested workspace arrays are unavailable')   ;   RETURN 
    420       ENDIF 
    421  
     420      IF( wrk_in_use(4, 1,2,3) .OR. wrk_in_use(3, 2,3) .OR. wrk_in_use(2, 1) ) THEN 
     421         CALL ctl_stop('ldf_slp_grif: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
     422      END IF 
     423      ! 
    422424      !--------------------------------! 
    423425      !  Some preliminary calculation  ! 
    … …  
    426428      CALL eos_alpbet( tsb, zalpha, zbeta )     !==  before thermal and haline expension coeff. at T-points  ==! 
    427429      ! 
    428       DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==! 
    429          DO jj = 1, jpjm1 
    430             DO ji = 1, fs_jpim1   ! vector opt. 
    431                zdit(ji,jj,jk) = ( tb(ji+1,jj,jk) - tb(ji,jj,jk) ) * umask(ji,jj,jk)   ! i-gradient of T and S at jj 
    432                zdis(ji,jj,jk) = ( sb(ji+1,jj,jk) - sb(ji,jj,jk) ) * umask(ji,jj,jk) 
    433                zdjt(ji,jj,jk) = ( tb(ji,jj+1,jk) - tb(ji,jj,jk) ) * vmask(ji,jj,jk)   ! j-gradient of T and S at jj 
    434                zdjs(ji,jj,jk) = ( sb(ji,jj+1,jk) - sb(ji,jj,jk) ) * vmask(ji,jj,jk) 
    435             END DO 
    436          END DO 
    437       END DO 
    438       IF( ln_zps ) THEN                               ! partial steps: correction at the last level 
     430      DO jn = 1, jpts 
     431         DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==! 
     432            DO jj = 1, jpjm1 
     433               DO ji = 1, fs_jpim1   ! vector opt. 
     434                  zdits(ji,jj,jk,jn) = ( tsb(ji+1,jj,jk,jn) - tsb(ji,jj,jk,jn) ) * umask(ji,jj,jk)   ! i-gradient of T and S at jj 
     435                  zdjts(ji,jj,jk,jn) = ( tsb(ji,jj+1,jk,jn) - tsb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)   ! j-gradient of T and S at jj 
     436               END DO 
     437            END DO 
     438         END DO 
     439         IF( ln_zps ) THEN                               ! partial steps: correction at the last level 
    439440# if defined key_vectopt_loop 
    440          DO jj = 1, 1 
    441             DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     441            DO jj = 1, 1 
     442               DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    442443# else 
    443          DO jj = 1, jpjm1 
    444             DO ji = 1, jpim1 
     444            DO jj = 1, jpjm1 
     445               DO ji = 1, jpim1 
    445446# endif 
    446                zdit(ji,jj,mbku(ji,jj)) = gtsu(ji,jj,jp_tem)                           ! i-gradient of T and S 
    447                zdis(ji,jj,mbku(ji,jj)) = gtsu(ji,jj,jp_sal) 
    448                zdjt(ji,jj,mbkv(ji,jj)) = gtsv(ji,jj,jp_tem)                           ! j-gradient of T and S 
    449                zdjs(ji,jj,mbkv(ji,jj)) = gtsv(ji,jj,jp_sal) 
    450             END DO 
    451          END DO 
    452       ENDIF 
    453       ! 
    454       zdkt(:,:,1) = 0._wp                    !==  before vertical T & S gradient at w-level  ==! 
    455       zdks(:,:,1) = 0._wp 
    456       DO jk = 2, jpk 
    457          zdkt(:,:,jk) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk) 
    458          zdks(:,:,jk) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk) 
    459       END DO 
    460       ! 
     447                  zdits(ji,jj,mbku(ji,jj),jn) = gtsu(ji,jj,jn)                           ! i-gradient of T and S 
     448                  zdjts(ji,jj,mbkv(ji,jj),jn) = gtsv(ji,jj,jn)                           ! j-gradient of T and S 
     449               END DO 
     450            END DO 
     451         ENDIF 
     452         ! 
     453         zdkts(:,:,1,jn) = 0._wp                    !==  before vertical T & S gradient at w-level  ==! 
     454         DO jk = 2, jpk 
     455            zdkts(:,:,jk,jn) = ( tsb(:,:,jk-1,jn) - tsb(:,:,jk,jn) ) * tmask(:,:,jk) 
     456         END DO 
     457         ! 
     458      END DO  
    461459      ! 
    462460      DO jl = 0, 1                           !==  density i-, j-, and k-gradients  ==! 
    … …  
    465463            DO jj = 1, jpjm1                       ! NB: not masked due to the minimum value set 
    466464               DO ji = 1, fs_jpim1   ! vector opt.  
    467                   zdxrho_raw = ( zalpha(ji+ip,jj   ,jk) * zdit(ji,jj,jk) + zbeta(ji+ip,jj   ,jk) * zdis(ji,jj,jk) ) / e1u(ji,jj) 
    468                   zdyrho_raw = ( zalpha(ji   ,jj+jp,jk) * zdjt(ji,jj,jk) + zbeta(ji   ,jj+jp,jk) * zdjs(ji,jj,jk) ) / e2v(ji,jj) 
     465                  zdxrho_raw = ( zalpha(ji+ip,jj   ,jk) * zdits(ji,jj,jk,jp_tem) + zbeta(ji+ip,jj   ,jk) * zdits(ji,jj,jk,jp_sal) ) / e1u(ji,jj) 
     466                  zdyrho_raw = ( zalpha(ji   ,jj+jp,jk) * zdjts(ji,jj,jk,jp_tem) + zbeta(ji   ,jj+jp,jk) * zdjts(ji,jj,jk,jp_sal) ) / e2v(ji,jj) 
    469467                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )    ! keep the sign 
    470468                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX(   repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    … …  
    477475            DO jj = 1, jpj                       ! NB: not masked due to the minimum value set 
    478476               DO ji = 1, jpi   ! vector opt.  
    479                   zdzrho_raw = ( zalpha(ji,jj,jk) * zdkt(ji,jj,jk+kp) + zbeta(ji,jj,jk) * zdks(ji,jj,jk+kp) )   & 
     477                  zdzrho_raw = ( zalpha(ji,jj,jk) * zdkts(ji,jj,jk+kp,jp_tem) + zbeta(ji,jj,jk) * zdkts(ji,jj,jk+kp,jp_sal) )   & 
    480478                     &       / fse3w(ji,jj,jk+kp) 
    481479                  zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )                    ! force zdzrho >= repsln 
    … …  
    600598      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    601599      ! 
    602       IF( wrk_not_released(3, 2,3,4,5) .OR.   & 
    603           wrk_not_released(2, 1)       )   CALL ctl_stop('ldf_slp_grif: failed to release workspace arrays') 
     600      IF( wrk_not_released(4, 1,2,3) .OR.   & 
     601          wrk_not_released(3, 2,3  ) .OR.   & 
     602          wrk_not_released(2, 1    )        )   CALL ctl_stop('ldf_slp_grif: ERROR: failed to release workspace arrays.') 
    604603      ! 
    605604   END SUBROUTINE ldf_slp_grif 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r2715 r2977  
    3434   LOGICAL , PUBLIC ::   l_triad_iso     = .FALSE.   !: calculate triads twice 
    3535   LOGICAL , PUBLIC ::   l_no_smooth     = .FALSE.   !: no Shapiro smoothing 
     36 
     37   REAL(wp), PUBLIC ::   rldf                        !: multiplicative factor of diffusive coefficient 
     38                                                     !: Needed to define the ratio between passive and active tracer diffusion coef.  
    3639 
    3740#if defined key_traldf_c3d 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90

    r2528 r2977  
    1212#if defined key_traldf_c3d 
    1313!   'key_traldf_c3d' :                 aht: 3D coefficient 
    14 #       define   fsahtt(i,j,k)   ahtt(i,j,k) 
    15 #       define   fsahtu(i,j,k)   ahtu(i,j,k) 
    16 #       define   fsahtv(i,j,k)   ahtv(i,j,k) 
    17 #       define   fsahtw(i,j,k)   ahtw(i,j,k) 
     14#       define   fsahtt(i,j,k)   rldf * ahtt(i,j,k) 
     15#       define   fsahtu(i,j,k)   rldf * ahtu(i,j,k) 
     16#       define   fsahtv(i,j,k)   rldf * ahtv(i,j,k) 
     17#       define   fsahtw(i,j,k)   rldf * ahtw(i,j,k) 
    1818#elif defined key_traldf_c2d 
    1919!   'key_traldf_c2d' :                 aht: 2D coefficient 
    20 #       define   fsahtt(i,j,k)   ahtt(i,j) 
    21 #       define   fsahtu(i,j,k)   ahtu(i,j) 
    22 #       define   fsahtv(i,j,k)   ahtv(i,j) 
    23 #       define   fsahtw(i,j,k)   ahtw(i,j) 
     20#       define   fsahtt(i,j,k)   rldf * ahtt(i,j) 
     21#       define   fsahtu(i,j,k)   rldf * ahtu(i,j) 
     22#       define   fsahtv(i,j,k)   rldf * ahtv(i,j) 
     23#       define   fsahtw(i,j,k)   rldf * ahtw(i,j) 
    2424#elif defined key_traldf_c1d 
    2525!   'key_traldf_c1d' :                aht: 1D coefficient 
    26 #       define   fsahtt(i,j,k)   ahtt(k) 
    27 #       define   fsahtu(i,j,k)   ahtu(k) 
    28 #       define   fsahtv(i,j,k)   ahtv(k) 
    29 #       define   fsahtw(i,j,k)   ahtw(k) 
     26#       define   fsahtt(i,j,k)   rldf * ahtt(k) 
     27#       define   fsahtu(i,j,k)   rldf * ahtu(k) 
     28#       define   fsahtv(i,j,k)   rldf * ahtv(k) 
     29#       define   fsahtw(i,j,k)   rldf * ahtw(k) 
    3030#else 
    3131!   Default option :             aht: Constant coefficient 
    32 #      define   fsahtt(i,j,k)   aht0 
    33 #      define   fsahtu(i,j,k)   aht0 
    34 #      define   fsahtv(i,j,k)   aht0 
    35 #      define   fsahtw(i,j,k)   aht0 
     32#      define   fsahtt(i,j,k)   rldf * aht0 
     33#      define   fsahtu(i,j,k)   rldf * aht0 
     34#      define   fsahtv(i,j,k)   rldf * aht0 
     35#      define   fsahtw(i,j,k)   rldf * aht0 
    3636#endif 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

    r2722 r2977  
    304304         IF (lp_obc_east) THEN  ! East 
    305305            DO ji = nie0 , nie1     
    306                sfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * sn (ji+1 , nje0:nje1 , :) * tmask(ji+1,nje0:nje1 , :) 
    307                tfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tn (ji+1 , nje0:nje1 , :) * tmask(ji+1,nje0:nje1 , :) 
    308                ufoe(nje0:nje1,:) = uemsk(nje0:nje1,:) * un (ji   , nje0:nje1 , :) * umask(ji,  nje0:nje1 , :) 
    309                vfoe(nje0:nje1,:) = vemsk(nje0:nje1,:) * vn (ji+1 , nje0:nje1 , :) * vmask(ji+1,nje0:nje1 , :) 
     306               sfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tsn(ji+1 , nje0:nje1 , :,jp_sal) * tmask(ji+1,nje0:nje1 , :) 
     307               tfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tsn(ji+1 , nje0:nje1 , :,jp_tem) * tmask(ji+1,nje0:nje1 , :) 
     308               ufoe(nje0:nje1,:) = uemsk(nje0:nje1,:) * un (ji   , nje0:nje1 , :)        * umask(ji,  nje0:nje1 , :) 
     309               vfoe(nje0:nje1,:) = vemsk(nje0:nje1,:) * vn (ji+1 , nje0:nje1 , :)        * vmask(ji+1,nje0:nje1 , :) 
    310310            END DO 
    311311         ENDIF 
    … …  
    313313         IF (lp_obc_west) THEN  ! West 
    314314            DO ji = niw0 , niw1     
    315                sfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * sn (ji , njw0:njw1 , :) * tmask(ji , njw0:njw1 , :) 
    316                tfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tn (ji , njw0:njw1 , :) * tmask(ji , njw0:njw1 , :) 
    317                ufow(njw0:njw1,:) = uwmsk(njw0:njw1,:) * un (ji , njw0:njw1 , :) * umask(ji , njw0:njw1 , :) 
    318                vfow(njw0:njw1,:) = vwmsk(njw0:njw1,:) * vn (ji , njw0:njw1 , :) * vmask(ji , njw0:njw1 , :) 
     315               sfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tsn(ji , njw0:njw1 , :,jp_sal) * tmask(ji , njw0:njw1 , :) 
     316               tfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tsn(ji , njw0:njw1 , :,jp_tem) * tmask(ji , njw0:njw1 , :) 
     317               ufow(njw0:njw1,:) = uwmsk(njw0:njw1,:) * un (ji , njw0:njw1 , :)        * umask(ji , njw0:njw1 , :) 
     318               vfow(njw0:njw1,:) = vwmsk(njw0:njw1,:) * vn (ji , njw0:njw1 , :)        * vmask(ji , njw0:njw1 , :) 
    319319            END DO 
    320320         ENDIF 
    … …  
    322322         IF (lp_obc_north) THEN ! North 
    323323            DO jj = njn0 , njn1 
    324                sfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * sn (nin0:nin1 , jj+1 , :) * tmask(nin0:nin1 , jj+1 , :) 
    325                tfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tn (nin0:nin1 , jj+1 , :) * tmask(nin0:nin1 , jj+1 , :) 
    326                ufon(nin0:nin1,:) = unmsk(nin0:nin1,:) * un (nin0:nin1 , jj+1 , :) * umask(nin0:nin1 , jj+1 , :) 
    327                vfon(nin0:nin1,:) = vnmsk(nin0:nin1,:) * vn (nin0:nin1 , jj   , :) * vmask(nin0:nin1 , jj   , :) 
     324               sfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tsn(nin0:nin1 , jj+1 , :,jp_sal) * tmask(nin0:nin1 , jj+1 , :) 
     325               tfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tsn(nin0:nin1 , jj+1 , :,jp_tem) * tmask(nin0:nin1 , jj+1 , :) 
     326               ufon(nin0:nin1,:) = unmsk(nin0:nin1,:) * un (nin0:nin1 , jj+1 , :)        * umask(nin0:nin1 , jj+1 , :) 
     327               vfon(nin0:nin1,:) = vnmsk(nin0:nin1,:) * vn (nin0:nin1 , jj   , :)        * vmask(nin0:nin1 , jj   , :) 
    328328            END DO 
    329329         ENDIF 
    … …  
    331331         IF (lp_obc_south) THEN ! South 
    332332            DO jj = njs0 , njs1 
    333                sfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * sn (nis0:nis1 , jj , :) * tmask(nis0:nis1 , jj , :) 
    334                tfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tn (nis0:nis1 , jj , :) * tmask(nis0:nis1 , jj , :) 
    335                ufos(nis0:nis1,:) = usmsk(nis0:nis1,:) * un (nis0:nis1 , jj , :) * umask(nis0:nis1 , jj , :) 
    336                vfos(nis0:nis1,:) = vsmsk(nis0:nis1,:) * vn (nis0:nis1 , jj , :) * vmask(nis0:nis1 , jj , :) 
     333               sfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tsn(nis0:nis1 , jj , :,jp_sal) * tmask(nis0:nis1 , jj , :) 
     334               tfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tsn(nis0:nis1 , jj , :,jp_tem) * tmask(nis0:nis1 , jj , :) 
     335               ufos(nis0:nis1,:) = usmsk(nis0:nis1,:) * un (nis0:nis1 , jj , :)        * umask(nis0:nis1 , jj , :) 
     336               vfos(nis0:nis1,:) = vsmsk(nis0:nis1,:) * vn (nis0:nis1 , jj , :)        * vmask(nis0:nis1 , jj , :) 
    337337            END DO 
    338338         ENDIF 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90

    r2715 r2977  
    215215                  sebnd(jj,jk,nibm,nitm) = sebnd(jj,jk,nibm,nit)*temsk(jj,jk) 
    216216         ! ... fields nit <== now (kt+1) 
    217                   tebnd(jj,jk,nib  ,nit) = tn(ji  ,jj,jk)*temsk(jj,jk) 
    218                   tebnd(jj,jk,nibm ,nit) = tn(ji-1,jj,jk)*temsk(jj,jk) 
    219                   sebnd(jj,jk,nib  ,nit) = sn(ji  ,jj,jk)*temsk(jj,jk) 
    220                   sebnd(jj,jk,nibm ,nit) = sn(ji-1,jj,jk)*temsk(jj,jk) 
     217                  tebnd(jj,jk,nib  ,nit) = tsn(ji  ,jj,jk,jp_tem)*temsk(jj,jk) 
     218                  tebnd(jj,jk,nibm ,nit) = tsn(ji-1,jj,jk,jp_tem)*temsk(jj,jk) 
     219                  sebnd(jj,jk,nib  ,nit) = tsn(ji  ,jj,jk,jp_sal)*temsk(jj,jk) 
     220                  sebnd(jj,jk,nibm ,nit) = tsn(ji-1,jj,jk,jp_sal)*temsk(jj,jk) 
    221221               END DO 
    222222            END DO 
    … …  
    481481                  swbnd(jj,jk,nibm ,nitm) = swbnd(jj,jk,nibm ,nit)*twmsk(jj,jk) 
    482482         ! ... fields nit <== now (kt+1) 
    483                   twbnd(jj,jk,nib  ,nit) = tn(ji   ,jj,jk)*twmsk(jj,jk) 
    484                   twbnd(jj,jk,nibm ,nit) = tn(ji+1 ,jj,jk)*twmsk(jj,jk) 
    485                   swbnd(jj,jk,nib  ,nit) = sn(ji   ,jj,jk)*twmsk(jj,jk) 
    486                   swbnd(jj,jk,nibm ,nit) = sn(ji+1 ,jj,jk)*twmsk(jj,jk) 
     483                  twbnd(jj,jk,nib  ,nit) = tsn(ji   ,jj,jk,jp_tem)*twmsk(jj,jk) 
     484                  twbnd(jj,jk,nibm ,nit) = tsn(ji+1 ,jj,jk,jp_tem)*twmsk(jj,jk) 
     485                  swbnd(jj,jk,nib  ,nit) = tsn(ji   ,jj,jk,jp_sal)*twmsk(jj,jk) 
     486                  swbnd(jj,jk,nibm ,nit) = tsn(ji+1 ,jj,jk,jp_sal)*twmsk(jj,jk) 
    487487               END DO 
    488488            END DO 
    … …  
    750750                  snbnd(ji,jk,nibm ,nitm) = snbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk) 
    751751         ! ... fields nit <== now (kt+1) 
    752                   tnbnd(ji,jk,nib  ,nit) = tn(ji,jj,  jk)*tnmsk(ji,jk) 
    753                   tnbnd(ji,jk,nibm ,nit) = tn(ji,jj-1,jk)*tnmsk(ji,jk) 
    754                   snbnd(ji,jk,nib  ,nit) = sn(ji,jj,  jk)*tnmsk(ji,jk) 
    755                   snbnd(ji,jk,nibm ,nit) = sn(ji,jj-1,jk)*tnmsk(ji,jk) 
     752                  tnbnd(ji,jk,nib  ,nit) = tsn(ji,jj,  jk,jp_tem)*tnmsk(ji,jk) 
     753                  tnbnd(ji,jk,nibm ,nit) = tsn(ji,jj-1,jk,jp_tem)*tnmsk(ji,jk) 
     754                  snbnd(ji,jk,nib  ,nit) = tsn(ji,jj,  jk,jp_sal)*tnmsk(ji,jk) 
     755                  snbnd(ji,jk,nibm ,nit) = tsn(ji,jj-1,jk,jp_sal)*tnmsk(ji,jk) 
    756756               END DO 
    757757            END DO 
    … …  
    10221022                  ssbnd(ji,jk,nibm ,nitm) = ssbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk) 
    10231023         ! ... fields nit <== now (kt+1) 
    1024                   tsbnd(ji,jk,nib  ,nit) = tn(ji,jj   ,jk)*tsmsk(ji,jk) 
    1025                   tsbnd(ji,jk,nibm ,nit) = tn(ji,jj+1 ,jk)*tsmsk(ji,jk) 
    1026                   ssbnd(ji,jk,nib  ,nit) = sn(ji,jj   ,jk)*tsmsk(ji,jk) 
    1027                   ssbnd(ji,jk,nibm ,nit) = sn(ji,jj+1 ,jk)*tsmsk(ji,jk) 
     1024                  tsbnd(ji,jk,nib  ,nit) = tsn(ji,jj   ,jk,jp_tem)*tsmsk(ji,jk) 
     1025                  tsbnd(ji,jk,nibm ,nit) = tsn(ji,jj+1 ,jk,jp_tem)*tsmsk(ji,jk) 
     1026                  ssbnd(ji,jk,nib  ,nit) = tsn(ji,jj   ,jk,jp_sal)*tsmsk(ji,jk) 
     1027                  ssbnd(ji,jk,nibm ,nit) = tsn(ji,jj+1 ,jk,jp_sal)*tsmsk(ji,jk) 
    10281028               END DO 
    10291029            END DO 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90

    r2528 r2977  
    5858      !!                     
    5959      !! ** Purpose :   Compute tracer fields (t,s) along the open boundaries. 
    60       !!      This routine is called by the tranxt.F routine and updates ta,sa 
     60      !!      This routine is called by the tranxt.F routine and updates tsa 
    6161      !!      which are the actual temperature and salinity fields. 
    6262      !!        The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north, 
    … …  
    101101      IF( lk_mpp ) THEN                  !!bug ??? 
    102102         IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
    103             CALL lbc_lnk( tb, 'T', 1. ) 
    104             CALL lbc_lnk( sb, 'T', 1. ) 
     103            CALL lbc_lnk( tsb(:,:,:,jp_tem), 'T', 1. ) 
     104            CALL lbc_lnk( tsb(:,:,:,jp_sal), 'T', 1. ) 
    105105         END IF 
    106          CALL lbc_lnk( ta, 'T', 1. ) 
    107          CALL lbc_lnk( sa, 'T', 1. ) 
     106         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 
     107         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    108108      ENDIF 
    109109 
    … …  
    116116      !!                   
    117117      !! ** Purpose : 
    118       !!      Apply the radiation algorithm on east OBC tracers ta, sa using the  
     118      !!      Apply the radiation algorithm on east OBC tracers tsa using the  
    119119      !!      phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module 
    120120      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC 
    … …  
    143143            DO jk = 1, jpkm1 
    144144               DO jj = 1, jpj 
    145                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) + & 
    146                                  tfoe(jj,jk)*temsk(jj,jk) 
    147                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - temsk(jj,jk)) + & 
    148                                  sfoe(jj,jk)*temsk(jj,jk) 
     145                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - temsk(jj,jk)) + & 
     146                                         tfoe(jj,jk)*temsk(jj,jk) 
     147                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - temsk(jj,jk)) + & 
     148                                         sfoe(jj,jk)*temsk(jj,jk) 
    149149               END DO 
    150150            END DO 
    … …  
    191191                  ztau = (1.-zin ) * rtauein  + zin * rtaue 
    192192                  z05cx = z05cx * zin 
    193          ! ... update ( ta, sa ) with radiative or climatological (t, s) 
    194                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) +           &  
     193         ! ... update tsa with radiative or climatological ts 
     194                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - temsk(jj,jk)) +           & 
    195195                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         & 
    196196                                 * tebnd(jj,jk,nib ,nitm) + 2.*z05cx              & 
    197197                                 * tebnd(jj,jk,nibm,nit ) + ztau * tfoe (jj,jk) ) & 
    198198                                 / (1. + z05cx) 
    199                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - temsk(jj,jk)) +           &  
     199                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - temsk(jj,jk)) +           & 
    200200                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         & 
    201201                                 * sebnd(jj,jk,nib ,nitm) + 2.*z05cx              & 
    … …  
    216216      !!            
    217217      !! ** Purpose : 
    218       !!      Apply the radiation algorithm on west OBC tracers ta, sa using the  
     218      !!      Apply the radiation algorithm on west OBC tracers tsa using the  
    219219      !!      phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module 
    220220      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC 
    … …  
    244244            DO jk = 1, jpkm1 
    245245               DO jj = 1, jpj 
    246                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) + & 
    247                                  tfow(jj,jk)*twmsk(jj,jk) 
    248                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - twmsk(jj,jk)) + & 
    249                                  sfow(jj,jk)*twmsk(jj,jk) 
     246                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - twmsk(jj,jk)) + & 
     247                                         tfow(jj,jk)*twmsk(jj,jk) 
     248                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - twmsk(jj,jk)) + & 
     249                                         sfow(jj,jk)*twmsk(jj,jk) 
    250250               END DO 
    251251            END DO 
    … …  
    290290                  ztau = (1.-zin )*rtauwin + zin * rtauw 
    291291                  z05cx = z05cx * zin 
    292          ! ... update (ta,sa) with radiative or climatological (t, s) 
    293                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) +           & 
     292         ! ... update tsa with radiative or climatological (ts) 
     293                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - twmsk(jj,jk)) +           & 
    294294                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         & 
    295295                                 * twbnd(jj,jk,nib ,nitm) - 2.*z05cx              & 
    296296                                 * twbnd(jj,jk,nibm,nit ) + ztau * tfow (jj,jk) ) & 
    297297                                 / (1. - z05cx) 
    298                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - twmsk(jj,jk)) +           & 
     298                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - twmsk(jj,jk)) +           & 
    299299                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         & 
    300300                                 * swbnd(jj,jk,nib ,nitm) - 2.*z05cx              & 
    … …  
    343343            DO jk = 1, jpkm1 
    344344               DO ji = 1, jpi 
    345                   ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) + & 
    346                                 tnmsk(ji,jk) * tfon(ji,jk) 
    347                   sa(ji,jj,jk)= sa(ji,jj,jk) * (1.-tnmsk(ji,jk)) + & 
    348                                 tnmsk(ji,jk) * sfon(ji,jk) 
     345                  tsa(ji,jj,jk,jp_tem)= tsa(ji,jj,jk,jp_tem) * (1.-tnmsk(ji,jk)) + & 
     346                                        tnmsk(ji,jk) * tfon(ji,jk) 
     347                  tsa(ji,jj,jk,jp_sal)= tsa(ji,jj,jk,jp_sal) * (1.-tnmsk(ji,jk)) + & 
     348                                        tnmsk(ji,jk) * sfon(ji,jk) 
    349349               END DO 
    350350            END DO 
    … …  
    392392                  ztau = (1.-zin ) * rtaunin + zin * rtaun 
    393393                  z05cx = z05cx * zin 
    394          ! ... update (ta,sa) with radiative or climatological (t, s) 
    395                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) +             & 
     394         ! ... update tsa with radiative or climatological (t, s) 
     395                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1.-tnmsk(ji,jk)) +             & 
    396396                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         & 
    397397                                 * tnbnd(ji,jk,nib ,nitm) + 2.*z05cx              & 
    398398                                 * tnbnd(ji,jk,nibm,nit ) + ztau * tfon (ji,jk) ) & 
    399399                                 / (1. + z05cx) 
    400                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1.-tnmsk(ji,jk)) +             & 
     400                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1.-tnmsk(ji,jk)) +             & 
    401401                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         & 
    402402                                 * snbnd(ji,jk,nib ,nitm) + 2.*z05cx              & 
    … …  
    417417      !!      
    418418      !! ** Purpose : 
    419       !!      Apply the radiation algorithm on south OBC tracers ta, sa using the  
     419      !!      Apply the radiation algorithm on south OBC tracers tsa using the  
    420420      !!      phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module 
    421421      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC 
    … …  
    445445            DO jk = 1, jpkm1 
    446446               DO ji = 1, jpi 
    447                   ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) + & 
    448                                 tsmsk(ji,jk) * tfos(ji,jk) 
    449                   sa(ji,jj,jk)= sa(ji,jj,jk) * (1.-tsmsk(ji,jk)) + & 
    450                                 tsmsk(ji,jk) * sfos(ji,jk) 
     447                  tsa(ji,jj,jk,jp_tem)= tsa(ji,jj,jk,jp_tem) * (1.-tsmsk(ji,jk)) + & 
     448                                        tsmsk(ji,jk) * tfos(ji,jk) 
     449                  tsa(ji,jj,jk,jp_sal)= tsa(ji,jj,jk,jp_sal) * (1.-tsmsk(ji,jk)) + & 
     450                                        tsmsk(ji,jk) * sfos(ji,jk) 
    451451               END DO 
    452452            END DO 
    … …  
    493493                  z05cx = z05cx * zin 
    494494 
    495          !... update (ta,sa) with radiative or climatological (t, s) 
    496                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) +             & 
     495         !... update tsa with radiative or climatological (t, s) 
     496                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1.-tsmsk(ji,jk)) +             & 
    497497                                 tsmsk(ji,jk) * ( ( 1. + z05cx - ztau )         & 
    498498                                 * tsbnd(ji,jk,nib ,nitm) - 2.*z05cx              & 
    499499                                 * tsbnd(ji,jk,nibm,nit ) + ztau * tfos (ji,jk) ) & 
    500500                                 / (1. - z05cx) 
    501                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1.-tsmsk(ji,jk)) +             & 
     501                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1.-tsmsk(ji,jk)) +             & 
    502502                                 tsmsk(ji,jk) * (  ( 1. + z05cx - ztau )        & 
    503503                                 * ssbnd(ji,jk,nib ,nitm) - 2.*z05cx              & 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r2733 r2977  
    10111011         & rday                          
    10121012      USE oce, ONLY : &                 ! Ocean dynamics and tracers variables 
    1013          & tn,  &              
    1014          & sn,  & 
     1013         & tsn,  &              
    10151014         & un, vn,  & 
    10161015         & sshn 
    … …  
    10661065         DO jprofset = 1, nprofsets 
    10671066            IF ( ld_enact(jprofset) ) THEN 
    1068                CALL obs_pro_opt( prodatqc(jprofset),                          & 
    1069                   &              kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,& 
    1070                   &              gdept_0, tmask, n1dint, n2dint,              & 
     1067               CALL obs_pro_opt( prodatqc(jprofset),                     & 
     1068                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
     1069                  &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   & 
     1070                  &              gdept_0, tmask, n1dint, n2dint,         & 
    10711071                  &              kdailyavtypes = endailyavtypes ) 
    10721072            ELSE 
    1073                CALL obs_pro_opt( prodatqc(jprofset),                          & 
    1074                   &              kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,& 
     1073               CALL obs_pro_opt( prodatqc(jprofset),                     & 
     1074                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
     1075                  &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   & 
    10751076                  &              gdept_0, tmask, n1dint, n2dint               ) 
    10761077            ENDIF 
    … …  
    10911092         DO jsstset = 1, nsstsets 
    10921093            CALL obs_sst_opt( sstdatqc(jsstset),                 & 
    1093                &              kstp, jpi, jpj, nit000, tn(:,:,1), & 
     1094               &              kstp, jpi, jpj, nit000, tsn(:,:,1,jp_tem), & 
    10941095               &              tmask(:,:,1), n2dint ) 
    10951096         END DO 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r2715 r2977  
    193193            ! 23.5 deg : tropics 
    194194            qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) ) 
    195             qns (ji,jj) = ztrp * ( tb(ji,jj,1) - t_star ) - qsr(ji,jj) 
     195            qns (ji,jj) = ztrp * ( tsb(ji,jj,1,jp_tem) - t_star ) - qsr(ji,jj) 
    196196            IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg 
    197197               emp  (ji,jj) =   zemp_S * zconv   & 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r2715 r2977  
    4141   USE geo2ocean       !  
    4242   USE restart         ! 
    43    USE oce   , ONLY : tn, un, vn 
     43   USE oce   , ONLY : tsn, un, vn 
    4444   USE albedo          ! 
    4545   USE in_out_manager  ! I/O manager 
    … …  
    10861086      !!---------------------------------------------------------------------- 
    10871087      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1088       USE wrk_nemo, ONLY:   zcptn  => wrk_2d_1   ! rcp * tn(:,:,1) 
     1088      USE wrk_nemo, ONLY:   zcptn  => wrk_2d_1   ! rcp * tsn(:,:,1,jp_tem) 
    10891089      USE wrk_nemo, ONLY:   ztmp   => wrk_2d_2   ! temporary array 
    10901090      USE wrk_nemo, ONLY:   zsnow  => wrk_2d_3   ! snow precipitation  
    … …  
    11151115 
    11161116      zicefr(:,:,1) = 1.- p_frld(:,:,1) 
    1117       IF( lk_diaar5 )   zcptn(:,:) = rcp * tn(:,:,1) 
     1117      IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 
    11181118      ! 
    11191119      !                                                      ! ========================= ! 
    … …  
    12701270      !                                                      ! ------------------------- ! 
    12711271      SELECT CASE( cn_snd_temperature) 
    1272       CASE( 'oce only'             )   ;   ztmp1(:,:) =   tn(:,:,1) + rt0 
    1273       CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:)    
     1272      CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
     1273      CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 
    12741274                                           ztmp2(:,:) =   tn_ice(:,:,1)     *  fr_i(:,:) 
    1275       CASE( 'mixed oce-ice'        )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 
     1275      CASE( 'mixed oce-ice'        )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 
    12761276      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 
    12771277      END SELECT 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r2715 r2977  
    110110               ENDIF 
    111111 
    112                tn(ji,jj,1) = MAX( tn(ji,jj,1), zt_fzp )     ! avoid over-freezing point temperature 
     112               tsn(ji,jj,1,jp_tem) = MAX( tsn(ji,jj,1,jp_tem), zt_fzp )     ! avoid over-freezing point temperature 
    113113 
    114114               qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover 
    … …  
    117117               !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0) 
    118118               !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1) 
    119                zqri = ztrp * ( tb(ji,jj,1) - ( zt_fzp - 1.) ) 
    120                zqrj = ztrp * MIN( 0., tb(ji,jj,1) - zt_fzp ) 
     119               zqri = ztrp * ( tsb(ji,jj,1,jp_tem) - ( zt_fzp - 1.) ) 
     120               zqrj = ztrp * MIN( 0., tsb(ji,jj,1,jp_tem) - zt_fzp ) 
    121121               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    & 
    122122                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r2715 r2977  
    327327      ! 
    328328      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    329          CALL prt_ctl(tab2d_1=fr_i      , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
    330          CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
    331          CALL prt_ctl(tab2d_1=(emps-rnf), clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 
    332          CALL prt_ctl(tab2d_1=qns       , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
    333          CALL prt_ctl(tab2d_1=qsr       , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
    334          CALL prt_ctl(tab3d_1=tmask     , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk ) 
    335          CALL prt_ctl(tab3d_1=tn        , clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
    336          CALL prt_ctl(tab3d_1=sn        , clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
    337          CALL prt_ctl(tab2d_1=utau      , clinfo1=' utau     - : ', mask1=umask,                      & 
    338             &         tab2d_2=vtau      , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 ) 
     329         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
     330         CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
     331         CALL prt_ctl(tab2d_1=(emps-rnf)       , clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 
     332         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
     333         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
     334         CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk ) 
     335         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
     336         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
     337         CALL prt_ctl(tab2d_1=utau             , clinfo1=' utau     - : ', mask1=umask,                      & 
     338            &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 ) 
    339339      ENDIF 
    340340      ! 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r2715 r2977  
    6464         ssu_m(:,:) = ub(:,:,1) 
    6565         ssv_m(:,:) = vb(:,:,1) 
    66          sst_m(:,:) = tn(:,:,1) 
    67          sss_m(:,:) = sn(:,:,1) 
     66         sst_m(:,:) = tsn(:,:,1,jp_tem) 
     67         sss_m(:,:) = tsn(:,:,1,jp_sal) 
    6868         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    6969         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    … …  
    104104               ssu_m(:,:) = zcoef * ub(:,:,1) 
    105105               ssv_m(:,:) = zcoef * vb(:,:,1) 
    106                sst_m(:,:) = zcoef * tn(:,:,1) 
    107                sss_m(:,:) = zcoef * sn(:,:,1) 
     106               sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 
     107               sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal) 
    108108               !                          ! removed inverse barometer ssh when Patm forcing is used  
    109109               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    … …  
    126126         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
    127127         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    128          sst_m(:,:) = sst_m(:,:) + tn(:,:,1) 
    129          sss_m(:,:) = sss_m(:,:) + sn(:,:,1) 
     128         sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem) 
     129         sss_m(:,:) = sss_m(:,:) + tsn(:,:,1,jp_sal) 
    130130         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    131131         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 *  ( ssh_ib(:,:) + ssh_ibb(:,:) ) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2715 r2977  
    111111      !!---------------------------------------------------------------------- 
    112112      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    113       USE oce     , ONLY:   zwx => ua       , zwy  => va         ! (ua,va) used as 3D workspace 
    114       USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zind => wrk_3d_2   ! 3D workspace 
    115       USE wrk_nemo, ONLY:   ztfreez => wrk_2d_1                  ! 2D     - 
     113      USE oce     , ONLY:   zwx => ua        , zwy  => va          ! (ua,va) used as 3D workspace 
     114      USE wrk_nemo, ONLY:   zwz => wrk_3d_12 , zind => wrk_3d_13   ! 3D workspace 
     115      USE wrk_nemo, ONLY:   ztfreez => wrk_2d_1                    ! 2D     - 
    116116      ! 
    117117      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    131131      !!---------------------------------------------------------------------- 
    132132 
    133       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN 
     133      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 12,13) ) THEN 
    134134         CALL ctl_stop('tra_adv_cen2: requested workspace arrays unavailable')   ;   RETURN 
    135135      ENDIF 
    … …  
    276276      ! 
    277277      IF( wrk_not_released(2, 1)   .OR.   & 
    278           wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays') 
     278          wrk_not_released(3, 12,13) )   CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays') 
    279279      ! 
    280280   END SUBROUTINE tra_adv_cen2 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r2715 r2977  
    6363      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    6464      USE oce     , ONLY:   zwx   => ua       , zwy   => va          ! (ua,va) used as workspace 
    65       USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2    ! 3D workspace 
     65      USE wrk_nemo, ONLY:   zslpx => wrk_3d_11 , zslpy => wrk_3d_12    ! 3D workspace 
    6666      ! 
    6767      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    7979      !!---------------------------------------------------------------------- 
    8080 
    81       IF( wrk_in_use(3, 1,2) ) THEN 
     81      IF( wrk_in_use(3, 11,12) ) THEN 
    8282         CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable')   ;   RETURN 
    8383      ENDIF 
    … …  
    252252      ENDDO 
    253253      ! 
    254       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable') 
     254      IF( wrk_not_released(3, 11,12) )   CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable') 
    255255      ! 
    256256   END SUBROUTINE tra_adv_muscl 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r2715 r2977  
    6161      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    6262      USE oce     , ONLY:   zwx   => ua       , zwy   => va         ! (ua,va) used as 3D workspace 
    63       USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2   ! 3D workspace 
     63      USE wrk_nemo, ONLY:   zslpx => wrk_3d_11, zslpy => wrk_3d_12   ! 3D workspace 
    6464      !! 
    6565      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    7777      !!---------------------------------------------------------------------- 
    7878 
    79       IF( wrk_in_use(3, 1,2) ) THEN 
     79      IF( wrk_in_use(3, 11,12) ) THEN 
    8080         CALL ctl_stop('tra_adv_muscl2: requested workspace arrays are unavailable')   ;   RETURN 
    8181      ENDIF 
    … …  
    285285      END DO 
    286286      ! 
    287       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_muscl2: failed to release workspace arrays') 
     287      IF( wrk_not_released(3, 11,12) )   CALL ctl_stop('tra_adv_muscl2: failed to release workspace arrays') 
    288288      ! 
    289289   END SUBROUTINE tra_adv_muscl2 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r2715 r2977  
    117117      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    118118      USE oce     , ONLY:   zwx => ua       ! ua used as workspace 
    119       USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace 
     119      USE wrk_nemo, ONLY:   zfu => wrk_3d_11 , zfc => wrk_3d_12, zfd => wrk_3d_13   ! 3D workspace 
    120120      ! 
    121121      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    131131      !---------------------------------------------------------------------- 
    132132      ! 
    133       IF( wrk_in_use(3, 1,2,3) ) THEN 
     133      IF( wrk_in_use(3, 11,12,13) ) THEN 
    134134         CALL ctl_stop('tra_adv_qck_i: requested workspace arrays unavailable')   ;   RETURN 
    135135      ENDIF 
    … …  
    228228      END DO 
    229229      ! 
    230       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_i: failed to release workspace arrays') 
     230      IF( wrk_not_released(3, 11,12,13) )   CALL ctl_stop('tra_adv_qck_i: failed to release workspace arrays') 
    231231      ! 
    232232   END SUBROUTINE tra_adv_qck_i 
    … …  
    240240      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    241241      USE oce     , ONLY:   zwy => ua       ! ua used as workspace 
    242       USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace 
     242      USE wrk_nemo, ONLY:   zfu => wrk_3d_11 , zfc => wrk_3d_12, zfd => wrk_3d_13   ! 3D workspace 
    243243      ! 
    244244      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    254254      !---------------------------------------------------------------------- 
    255255      ! 
    256       IF(wrk_in_use(3, 1,2,3))THEN 
     256      IF(wrk_in_use(3, 11,12,13))THEN 
    257257         CALL ctl_stop('tra_adv_qck_j: ERROR: requested workspace arrays unavailable') 
    258258         RETURN 
    … …  
    359359      END DO 
    360360      ! 
    361       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_j: failed to release workspace arrays') 
     361      IF( wrk_not_released(3, 11,12,13) )   CALL ctl_stop('tra_adv_qck_j: failed to release workspace arrays') 
    362362      ! 
    363363   END SUBROUTINE tra_adv_qck_j 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r2715 r2977  
    1414   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter 
    1515   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC  
     16   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys 
    1617   !!---------------------------------------------------------------------- 
    17 #if   defined key_tradmp   ||   defined key_esopa 
    18    !!---------------------------------------------------------------------- 
    19    !!   'key_tradmp'                                       internal damping 
     18 
    2019   !!---------------------------------------------------------------------- 
    2120   !!   tra_dmp_alloc : allocate tradmp arrays 
    … …  
    3231   USE zdf_oce        ! ocean: vertical physics 
    3332   USE phycst         ! physical constants 
    34    USE dtatem         ! data: temperature 
    35    USE dtasal         ! data: salinity 
     33   USE dtatsd         ! data: temperature & salinity 
    3634   USE zdfmxl         ! vertical physics: mixed layer depth 
    3735   USE in_out_manager ! I/O manager 
    … …  
    4745   PUBLIC   dtacof_zoom  ! routine called by in both tradmp.F90 and trcdmp.F90 
    4846 
    49 #if ! defined key_agrif 
    50    LOGICAL, PUBLIC, PARAMETER ::   lk_tradmp = .TRUE.     !: internal damping flag 
    51 #else 
    52    LOGICAL, PUBLIC            ::   lk_tradmp = .TRUE.     !: internal damping flag 
    53 #endif 
     47   !                                !!* Namelist namtra_dmp : T & S newtonian damping * 
     48   LOGICAL, PUBLIC ::   ln_tradmp = .TRUE.    !: internal damping flag 
     49   INTEGER         ::   nn_hdmp   =   -1      ! = 0/-1/'latitude' for damping over T and S 
     50   INTEGER         ::   nn_zdmp   =    0      ! = 0/1/2 flag for damping in the mixed layer 
     51   REAL(wp)        ::   rn_surf   =   50._wp  ! surface time scale for internal damping        [days] 
     52   REAL(wp)        ::   rn_bot    =  360._wp  ! bottom time scale for internal damping         [days] 
     53   REAL(wp)        ::   rn_dep    =  800._wp  ! depth of transition between rn_surf and rn_bot [meters] 
     54   INTEGER         ::   nn_file   =    2      ! = 1 create a damping.coeff NetCDF file  
     55 
    5456   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s) 
    5557   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s) 
    5658   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1) 
    57     
    58    !                                !!* Namelist namtra_dmp : T & S newtonian damping * 
    59    INTEGER  ::   nn_hdmp =   -1      ! = 0/-1/'latitude' for damping over T and S 
    60    INTEGER  ::   nn_zdmp =    0      ! = 0/1/2 flag for damping in the mixed layer 
    61    REAL(wp) ::   rn_surf =   50._wp  ! surface time scale for internal damping        [days] 
    62    REAL(wp) ::   rn_bot  =  360._wp  ! bottom time scale for internal damping         [days] 
    63    REAL(wp) ::   rn_dep  =  800._wp  ! depth of transition between rn_surf and rn_bot [meters] 
    64    INTEGER  ::   nn_file =    2      ! = 1 create a damping.coeff NetCDF file  
    6559 
    6660   !! * Substitutions 
    … …  
    7670   INTEGER FUNCTION tra_dmp_alloc() 
    7771      !!---------------------------------------------------------------------- 
    78       !!                ***  FUNCTION tra_bbl_alloc  *** 
    79       !!---------------------------------------------------------------------- 
    80       ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) , resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
     72      !!                ***  FUNCTION tra_dmp_alloc  *** 
     73      !!---------------------------------------------------------------------- 
     74      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
    8175      ! 
    8276      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc ) 
    8377      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed') 
     78      ! 
    8479   END FUNCTION tra_dmp_alloc 
    8580 
    … …  
    10398      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend 
    10499      !!---------------------------------------------------------------------- 
     100      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     101      USE wrk_nemo, ONLY:   zts_dta => wrk_4d_2  ! 4D workspace 
     102      ! 
    105103      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    106104      !! 
    107105      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    108       REAL(wp) ::   zta, zsa     ! local scalars 
    109       !!---------------------------------------------------------------------- 
     106      REAL(wp) ::   zta, zsa             ! local scalars 
     107      !!---------------------------------------------------------------------- 
     108      ! 
     109      IF( wrk_in_use(4, 2) ) THEN 
     110         CALL ctl_stop('tra_dmp: requested workspace arrays unavailable')   ;   RETURN 
     111      ENDIF 
     112      !                           !==   input T-S data at kt   ==! 
     113      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt 
    110114      ! 
    111115      SELECT CASE ( nn_zdmp )     !==    type of damping   ==! 
    … …  
    115119            DO jj = 2, jpjm1 
    116120               DO ji = fs_2, fs_jpim1   ! vector opt. 
    117                   zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    118                   zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     121                  zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     122                  zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    119123                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 
    120124                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    121                   strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj) 
    122                   ttrdmp(ji,jj,jk) = zta 
     125                  strdmp(ji,jj,jk) = zsa           ! save the trend (used in asmtrj) 
     126                  ttrdmp(ji,jj,jk) = zta       
    123127               END DO 
    124128            END DO 
    … …  
    130134               DO ji = fs_2, fs_jpim1   ! vector opt. 
    131135                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 
    132                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    133                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     136                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     137                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    134138                  ELSE 
    135139                     zta = 0._wp 
    … …  
    149153               DO ji = fs_2, fs_jpim1   ! vector opt. 
    150154                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    151                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    152                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     155                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     156                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    153157                  ELSE 
    154158                     zta = 0._wp 
    … …  
    173177         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    174178      ! 
     179      IF( wrk_not_released(4, 2) )  CALL ctl_stop('tra_dmp: failed to release workspace arrays') 
     180      ! 
    175181   END SUBROUTINE tra_dmp 
    176182 
    … …  
    184190      !! ** Method  :   read the nammbf namelist and check the parameters 
    185191      !!---------------------------------------------------------------------- 
    186       NAMELIST/namtra_dmp/ nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 
     192      NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 
    187193      !!---------------------------------------------------------------------- 
    188194 
    … …  
    194200      IF(lwp) THEN                       ! Namelist print 
    195201         WRITE(numout,*) 
    196          WRITE(numout,*) 'tra_dmp : T and S newtonian damping' 
     202         WRITE(numout,*) 'tra_dmp_init : T and S newtonian damping' 
    197203         WRITE(numout,*) '~~~~~~~' 
    198204         WRITE(numout,*) '   Namelist namtra_dmp : set damping parameter' 
    199          WRITE(numout,*) '      T and S damping option         nn_hdmp = ', nn_hdmp 
    200          WRITE(numout,*) '      mixed layer damping option     nn_zdmp = ', nn_zdmp, '(zoom: forced to 0)' 
    201          WRITE(numout,*) '      surface time scale (days)      rn_surf = ', rn_surf 
    202          WRITE(numout,*) '      bottom time scale (days)       rn_bot  = ', rn_bot 
    203          WRITE(numout,*) '      depth of transition (meters)   rn_dep  = ', rn_dep 
    204          WRITE(numout,*) '      create a damping.coeff file    nn_file = ', nn_file 
    205       ENDIF 
    206  
    207       !                              ! allocate tradmp arrays 
    208       IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
    209  
    210       SELECT CASE ( nn_hdmp ) 
    211       CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
    212       CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees' 
    213       CASE DEFAULT 
    214          WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp 
    215          CALL ctl_stop(ctmp1) 
    216       END SELECT 
    217  
    218       SELECT CASE ( nn_zdmp ) 
    219       CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    220       CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
    221       CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
    222       CASE DEFAULT 
    223          WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 
    224          CALL ctl_stop(ctmp1) 
    225       END SELECT 
    226  
    227       IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem )   & 
    228          &   CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' ) 
    229  
    230       strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj) 
    231       ttrdmp(:,:,:) = 0._wp 
    232       !                          ! Damping coefficients initialization 
    233       IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto ) 
    234       ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep,  & 
    235                              &            nn_file, 'TRA'  , resto            ) 
     205         WRITE(numout,*) '      add a damping termn or not      ln_tradmp = ', ln_tradmp 
     206         WRITE(numout,*) '      T and S damping option          nn_hdmp   = ', nn_hdmp 
     207         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp, '(zoom: forced to 0)' 
     208         WRITE(numout,*) '      surface time scale (days)       rn_surf   = ', rn_surf 
     209         WRITE(numout,*) '      bottom time scale (days)        rn_bot    = ', rn_bot 
     210         WRITE(numout,*) '      depth of transition (meters)    rn_dep    = ', rn_dep 
     211         WRITE(numout,*) '      create a damping.coeff file     nn_file   = ', nn_file 
     212         WRITE(numout,*) 
     213      ENDIF 
     214 
     215      IF( ln_tradmp ) THEN               ! initialization for T-S damping 
     216         ! 
     217         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
     218         ! 
     219         SELECT CASE ( nn_hdmp ) 
     220         CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
     221         CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees' 
     222         CASE DEFAULT 
     223            WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp 
     224            CALL ctl_stop(ctmp1) 
     225         END SELECT 
     226         ! 
     227         SELECT CASE ( nn_zdmp ) 
     228         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
     229         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     230         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
     231         CASE DEFAULT 
     232            WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 
     233            CALL ctl_stop(ctmp1) 
     234         END SELECT 
     235         ! 
     236         IF( .NOT.ln_tsd_tradmp ) THEN 
     237            CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' ) 
     238            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data 
     239         ENDIF 
     240         ! 
     241         strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj) 
     242         ttrdmp(:,:,:) = 0._wp 
     243         !                          ! Damping coefficients initialization 
     244         IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto ) 
     245         ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'TRA', resto ) 
     246         ENDIF 
     247         ! 
    236248      ENDIF 
    237249      ! 
    … …  
    347359      !!---------------------------------------------------------------------- 
    348360 
    349       IF( wrk_in_use(1, 1) .OR.   & 
    350           wrk_in_use(2, 1) .OR.   & 
    351           wrk_in_use(3, 1)   ) THEN 
     361      IF( wrk_in_use(1, 1) .OR. wrk_in_use(2, 1) .OR. wrk_in_use(3, 1)  ) THEN  
    352362          CALL ctl_stop('dtacof: requested workspace arrays unavailable')   ;   RETURN 
    353363      ENDIF 
    … …  
    529539      ELSE                         !     No damping     ! 
    530540         !                         !--------------------! 
    531          CALL ctl_stop( 'Choose a correct value of nn_hdmp or DO NOT defined key_tradmp' ) 
     541         CALL ctl_stop( 'Choose a correct value of nn_hdmp or put ln_tradmp to FALSE' ) 
    532542      ENDIF 
    533543 
    … …  
    544554      ENDIF 
    545555      ! 
    546       IF( wrk_not_released(1, 1) .OR.   & 
    547           wrk_not_released(2, 1) .OR.   & 
    548           wrk_not_released(3, 1) )   CALL ctl_stop('dtacof: failed to release workspace arrays') 
     556      IF( wrk_not_released(1, 1) .OR.  wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )  &  
     557         &                      CALL ctl_stop('dtacof: failed to release workspace arrays') 
    549558      ! 
    550559   END SUBROUTINE dtacof 
    … …  
    572581      !!---------------------------------------------------------------------- 
    573582      USE ioipsl      ! IOipsl librairy 
    574       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    575       USE wrk_nemo, ONLY:   zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4 
     583      USE wrk_nemo, ONLY:  wrk_in_use, wrk_not_released 
     584      USE wrk_nemo, ONLY:  zxt => wrk_2d_1, zyt   => wrk_2d_2  
     585      USE wrk_nemo, ONLY:  zzt => wrk_2d_3, zmask => wrk_2d_4 
    576586      !! 
    577587      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline 
    … …  
    585595      !!---------------------------------------------------------------------- 
    586596 
    587       IF( wrk_in_use(2, 1,2,3,4) .OR.  & 
    588           wrk_in_use(1, 1,2,3,4)  ) THEN 
     597      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
    589598          CALL ctl_stop('cofdis: requested workspace arrays unavailable')   ;   RETURN 
    590599      ENDIF 
    … …  
    745754      CALL restclo( icot ) 
    746755      ! 
    747       IF( wrk_not_released(2, 1,2,3,4) .OR. &  
    748           wrk_not_released(1, 1,2,3,4)  )   CALL ctl_stop('cofdis: failed to release workspace arrays') 
    749       DEALLOCATE( llcotu , llcotv , llcotf ,      & 
    750          &        zxc    , zyc    , zzc    , zdis ) 
     756      IF( wrk_not_released(2, 1,2,3,4) ) CALL ctl_stop('cofdis: failed to release workspace arrays') 
     757      DEALLOCATE( llcotu, llcotv, llcotf, zyc, zzc, zdis ) 
    751758      ! 
    752759   END SUBROUTINE cofdis 
    753  
    754 #else 
    755    !!---------------------------------------------------------------------- 
    756    !!   Default key                                     NO internal damping 
    757    !!---------------------------------------------------------------------- 
    758    LOGICAL , PUBLIC, PARAMETER ::   lk_tradmp = .FALSE.    !: internal damping flag 
    759 CONTAINS 
    760    SUBROUTINE tra_dmp( kt )        ! Empty routine 
    761       WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt 
    762    END SUBROUTINE tra_dmp 
    763    SUBROUTINE tra_dmp_init        ! Empty routine 
    764    END SUBROUTINE tra_dmp_init 
    765 #endif 
    766  
    767760   !!====================================================================== 
    768761END MODULE tradmp 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r2715 r2977  
    6161      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds 
    6262      !!---------------------------------------------------------------------- 
     63 
     64      rldf = 1     ! For active tracers the  
    6365 
    6466      IF( l_trdtra )   THEN                    !* Save ta and sa trends 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r2715 r2977  
    4242   USE prtctl          ! Print control 
    4343   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    44    USE traswp          ! swap array 
    4544   USE obc_oce  
    4645#if defined key_agrif 
    … …  
    111110      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    112111      ! 
    113 #if defined key_obc || defined key_bdy || defined key_agrif 
    114       CALL tra_unswap 
    115 #endif 
    116  
    117112#if defined key_obc  
    118113      IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries 
    … …  
    123118#if defined key_agrif 
    124119      CALL Agrif_tra                     ! AGRIF zoom boundaries 
    125 #endif 
    126  
    127 #if defined key_obc || defined key_bdy || defined key_agrif 
    128       CALL tra_swap 
    129120#endif 
    130121  
    … …  
    155146#if defined key_agrif 
    156147      ! Update tracer at AGRIF zoom boundaries 
    157       CALL tra_unswap 
    158148      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only 
    159       CALL tra_swap 
    160149#endif       
    161150      ! 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90

    r2781 r2977  
    106106         ! 
    107107      CASE( 'TRA' )              ! Tracers 
    108          t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tn(:,:,1) ) 
    109          s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * sn(:,:,1) ) 
     108         t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tsn(:,:,1,jp_tem) ) 
     109         s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tsn(:,:,1,jp_sal) ) 
    110110         !       
    111111      END SELECT 
    … …  
    184184         s2(ktrd) = 0._wp 
    185185         DO jk = 1, jpkm1 
    186             t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(:,:,jk) * tn(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    187             s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(:,:,jk) * sn(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     186            t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(:,:,jk) * tsn(:,:,jk,jp_tem) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     187            s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(:,:,jk) * tsn(:,:,jk,jp_sal) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    188188         END DO 
    189189         ! 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r2715 r2977  
    293293               zavt = avt(ji,jj,ik) 
    294294               tmltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
    295                   &                      * ( tn(ji,jj,ik-1) - tn(ji,jj,ik) )         & 
     295                  &                      * ( tsn(ji,jj,ik-1,jp_tem) - tsn(ji,jj,ik,jp_tem) )         & 
    296296                  &                      / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 
    297297               zavt = fsavs(ji,jj,ik) 
    298298               smltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
    299                   &                      * ( sn(ji,jj,ik-1) - sn(ji,jj,ik) )         & 
     299                  &                      * ( tsn(ji,jj,ik-1,jp_sal) - tsn(ji,jj,ik,jp_sal) )         & 
    300300                  &                      / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 
    301301            END DO 
    … …  
    334334      tml(:,:) = 0.e0   ;   sml(:,:) = 0.e0 
    335335      DO jk = 1, jpktrd - 1 
    336          tml(:,:) = tml(:,:) + wkx(:,:,jk) * tn(:,:,jk) 
    337          sml(:,:) = sml(:,:) + wkx(:,:,jk) * sn(:,:,jk)  
     336         tml(:,:) = tml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_tem) 
     337         sml(:,:) = sml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_sal) 
    338338      END DO 
    339339 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90

    r2715 r2977  
    101101            CASE ( jptra_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )   ! z- vertical adv  
    102102                                         CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )    
    103                                          ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
    104                                          z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
    105                                          z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
     103                                         ! compute the surface flux condition wn(:,:,1)*tsn(:,:,1,jp_tem) 
     104                                         z2dx(:,:) = wn(:,:,1)*tsn(:,:,1,jp_tem)/fse3t(:,:,1) 
     105                                         z2dy(:,:) = wn(:,:,1)*tsn(:,:,1,jp_sal)/fse3t(:,:,1) 
    106106                                         CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )   ! 1st z- vertical adv  
    107107            END SELECT 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r2715 r2977  
    131131      !!              coefficients using the GLS turbulent closure scheme. 
    132132      !!---------------------------------------------------------------------- 
    133       USE oce,     z_elem_a  =>   ua   ! use ua as workspace 
    134       USE oce,     z_elem_b  =>   va   ! use va as workspace 
    135       USE oce,     z_elem_c  =>   ta   ! use ta as workspace 
    136       USE oce,     psi       =>   sa   ! use sa as workspace 
     133      USE oce     , ONLY z_elem_a  =>   ua   ! use ua as workspace 
     134      USE oce     , ONLY z_elem_b  =>   va   ! use va as workspace 
     135      USE oce     , ONLY tsa                 ! use tsa as workspace 
    137136      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    138137      USE wrk_nemo, ONLY: zdep  => wrk_2d_1 
    … …  
    152151      REAL(wp) ::   prod, buoy, diss, zdiss, sm         !   -      - 
    153152      REAL(wp) ::   gh, gm, shr, dif, zsqen, zav        !   -      - 
     153      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_c, psi 
    154154      !!-------------------------------------------------------------------- 
    155155 
    … …  
    157157         CALL ctl_stop('zdf_gls: requested workspace arrays unavailable.')   ;   RETURN 
    158158      END IF 
     159      ! 
     160      z_elem_c  => tsa(:,:,:,1) 
     161      psi       => tsa(:,:,:,2) 
    159162 
    160163      ! Preliminary computing 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r2715 r2977  
    206206      !!         the equation number. (LMD94, here after) 
    207207      !!---------------------------------------------------------------------- 
    208 #if defined  key_zdfddm 
    209208      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace 
    210       USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace 
    211       USE oce     , zdiffus => sa   ! temp. array for diffusivities use sa as workspace 
    212 #else 
    213       USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace 
    214       USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace 
    215 #endif 
     209      USE oce     , zdiffut => va   ! temp. array for diffusivities use sa as workspace 
    216210      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz 
    217211      USE wrk_nemo, ONLY: zBo    => wrk_2d_1, &  ! Surface buoyancy forcing, 
    … …  
    229223                          zblct => wrk_xz_2      !  diffusivities/viscosities 
    230224#if defined key_zdfddm 
    231       USE wrk_nemo, ONLY: zblcs => wrk_xz_3 
     225      USE wrk_nemo, ONLY: zdiffus => wrk_3d_1 
     226      USE wrk_nemo, ONLY: zblcs   => wrk_xz_3 
    232227#endif 
    233228      !! 
    … …  
    270265      REAL(wp), POINTER, DIMENSION(:,:) ::     zdifs 
    271266      REAL(wp), POINTER, DIMENSION(:)   ::   za2s, za3s, zkmps 
    272       REAL(wp) ::                       zkm1s 
     267      REAL(wp) ::                            zkm1s 
    273268#endif 
    274269      !!-------------------------------------------------------------------- 
    … …  
    276271      IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR.   & 
    277272          wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR.   & 
     273          wrk_in_use(3, 1)                                .OR. & 
    278274          wrk_in_use_xz(1,2,3)                              ) THEN 
    279275         CALL ctl_stop('zdf_kpp : requested workspace arrays unavailable.')   ;   RETURN 
    … …  
    369365               ! only retains positive value of rrau 
    370366               zrrau = MAX( rrau(ji,jj,jk), epsln ) 
    371                zds   = sn(ji,jj,jk-1) - sn(ji,jj,jk) 
     367               zds   = tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) 
    372368               IF( zrrau > 1. .AND. zds > 0.) THEN 
    373369                  ! 
    … …  
    418414         DO ji = fs_2, fs_jpim1      
    419415            IF( nn_eos < 1) THEN    
    420                zt     = tn(ji,jj,1) 
    421                zs     = sn(ji,jj,1) - 35.0 
     416               zt     = tsn(ji,jj,1,jp_tem) 
     417               zs     = tsn(ji,jj,1,jp_sal) - 35.0 
    422418               zh     = fsdept(ji,jj,1) 
    423419               !  potential volumic mass 
    … …  
    449445 
    450446               zthermal = zbeta * zalbet / ( rcp * zrhos + epsln ) 
    451                zhalin   = zbeta * sn(ji,jj,1) * rcs 
     447               zhalin   = zbeta * tsn(ji,jj,1,jp_sal) * rcs 
    452448            ELSE 
    453449               zrhos    = rhop(ji,jj,1) + rau0 * ( 1. - tmask(ji,jj,1) ) 
    454450               zthermal = rn_alpha / ( rcp * zrhos + epsln ) 
    455                zhalin   = rn_beta * sn(ji,jj,1) * rcs 
     451               zhalin   = rn_beta * tsn(ji,jj,1,jp_sal) * rcs 
    456452            ENDIF 
    457453            ! Radiative surface buoyancy force 
    … …  
    462458            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1) 
    463459            ! Surface salinity flux for non-local term 
    464             ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * sn(ji,jj,1) * rcs ) * tmask(ji,jj,1)  
     460            ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) * rcs ) * tmask(ji,jj,1)  
    465461         ENDDO 
    466462      ENDDO 
    … …  
    543539               ! zref = gdept(1) 
    544540               zref = fsdept(ji,jj,1) 
    545                zt   = tn(ji,jj,1) 
    546                zs   = sn(ji,jj,1) 
     541               zt   = tsn(ji,jj,1,jp_tem) 
     542               zs   = tsn(ji,jj,1,jp_sal) 
    547543               zrh  = rhop(ji,jj,1) 
    548544               zu   = ( ub(ji,jj,1) + ub(ji - 1,jj    ,1) ) / MAX( 1. , umask(ji,jj,1) + umask(ji - 1,jj   ,1) ) 
    … …  
    556552               ! vertically integration over the upper epsilon*gdept(jk) ; del () array is computed once in zdf_kpp_init 
    557553               DO jm = 1, jpkm1 
    558                   zt   = zt  + del(jk,jm) * tn(ji,jj,jm) 
    559                   zs   = zs  + del(jk,jm) * sn(ji,jj,jm) 
     554                  zt   = zt  + del(jk,jm) * tsn(ji,jj,jm,jp_tem) 
     555                  zs   = zs  + del(jk,jm) * tsn(ji,jj,jm,jp_sal) 
    560556                  zu   = zu  + 0.5 * del(jk,jm) & 
    561557                     &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) & 
    … …  
    567563               END DO 
    568564#endif 
    569                zsr = SQRT( ABS( sn(ji,jj,jk) ) ) 
     565               zsr = SQRT( ABS( tsn(ji,jj,jk,jp_sal) ) ) 
    570566               ! depth 
    571567               zh = fsdept(ji,jj,jk) 
    … …  
    12341230         ENDIF 
    12351231 
    1236       IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR.   & 
    1237           wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR.   & 
    1238           wrk_not_released_xz(1,2,3)                               )  & 
    1239           CALL ctl_stop('zdf_kpp : failed to release workspace arrays') 
     1232      IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 
     1233          wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR. & 
     1234          wrk_not_released(3, 1)                                .OR. & 
     1235          wrk_not_released_xz(1,2,3)  )   CALL ctl_stop('zdf_kpp : failed to release workspace arrays') 
    12401236      ! 
    12411237   END SUBROUTINE zdf_kpp 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r2715 r2977  
    191191      !! --------------------------------------------------------------------- 
    192192      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    193       USE oce     , ONLY:   zdiag => ua , zd_up => va , zd_lw => ta   ! (ua,va,ta) used as workspace 
     193      USE oce     , ONLY:   zdiag => ua          ! (ua,va) used  as workspace 
     194      USE oce     , ONLY:   tsa                  ! (tsa) used  as workspace 
    194195      USE wrk_nemo, ONLY:   imlc  => iwrk_2d_1   ! 2D INTEGER workspace 
    195196      USE wrk_nemo, ONLY:   zhlc  =>  wrk_2d_1   ! 2D REAL workspace 
    196197      USE wrk_nemo, ONLY:   zpelc =>  wrk_3d_1   ! 3D REAL workspace 
    197       ! 
     198      !! 
    198199      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    199200!!bfr      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1      ! temporary scalar 
    … …  
    208209      REAL(wp) ::   zzd_up, zzd_lw                  !    -         - 
    209210!!bfr      REAL(wp) ::   zebot                           !    -         - 
     211      REAL(wp), POINTER, DIMENSION(:,:,:) :: zd_up, zd_lw 
    210212      !!-------------------------------------------------------------------- 
    211213      ! 
    … …  
    215217         CALL ctl_stop('tke_tke: requested workspace arrays unavailable')   ;   RETURN 
    216218      END IF 
     219      ! 
     220      zd_up => tsa(:,:,:,1)  
     221      zd_lw => tsa(:,:,:,2)  
    217222 
    218223      zbbrau = rn_ebb / rau0       ! Local constant initialisation 
    … …  
    471476      !!              - avmu, avmv : now vertical eddy viscosity at uw- and vw-points 
    472477      !!---------------------------------------------------------------------- 
    473       USE oce, ONLY:   zmpdl => ua , zmxlm => va , zmxld => ta   ! (ua,va,ta) used as workspace 
     478      USE oce, ONLY:  zmpdl => ua    ! ua used as workspace 
     479      USE oce, ONLY:  tsa            ! use tsa as workspace 
    474480      !! 
    475481      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    477483      REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      - 
    478484      REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      - 
     485      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxlm, zmxld 
    479486      !!-------------------------------------------------------------------- 
     487      ! 
     488      zmxlm => tsa(:,:,:,1)  
     489      zmxld => tsa(:,:,:,2)  
    480490 
    481491      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2715 r2977  
    320320                            CALL tra_bbc_init   ! bottom heat flux 
    321321      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    322       IF( lk_tradmp     )   CALL tra_dmp_init   ! internal damping trends 
     322      IF( ln_tradmp     )   CALL tra_dmp_init   ! internal damping trends 
    323323                            CALL tra_adv_init   ! horizontal & vertical advection 
    324324                            CALL tra_ldf_init   ! lateral mixing 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r2715 r2977  
    2525   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity           [s-1] 
    2626   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence        [s-1] 
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   tb   ,  tn    , ta     !: potential temperature    [Celcius] 
    28    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sb   ,  sn    , sa     !: salinity                     [psu] 
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields        [Celcius,psu]  
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn            !: 4D T-S fields        [Celcius,psu]  
    3028   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2   [s-2] 
     29   ! 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), TARGET ::  tsa             !: 4D T-S trends fields & work array  
    3131   ! 
    3232   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
    … …  
    6666         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &    
    6767         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             & 
    68          &      tb   (jpi,jpj,jpk)      , tn   (jpi,jpj,jpk)      , ta(jpi,jpj,jpk)       ,     & 
    69          &      sb   (jpi,jpj,jpk)      , sn   (jpi,jpj,jpk)      , sa (jpi,jpj,jpk)      ,     &       
    7068         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     & 
    7169         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) ) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/step.F90

    r2715 r2977  
    2323   !!            3.3  !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    2424   !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
     25   !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal 
    2526   !!---------------------------------------------------------------------- 
    2627 
    … …  
    9495      ! Update data, open boundaries, surface boundary condition (including sea-ice) 
    9596      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    96       IF( lk_dtatem  )   CALL dta_tem( kstp )         ! update 3D temperature data 
    97       IF( lk_dtasal  )   CALL dta_sal( kstp )         ! update 3D salinity data 
    9897                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    9998      IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries 
    … …  
    107106 
    108107      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    109       ! Ocean physics update                (ua, va, ta, sa used as workspace) 
     108      ! Ocean physics update                (ua, va, tsa used as workspace) 
    110109      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    111110                         CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency 
    … …  
    158157 
    159158      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    160       ! diagnostics and outputs             (ua, va, ta, sa used as workspace) 
     159      ! diagnostics and outputs             (ua, va, tsa used as workspace) 
    161160      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    162161      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    … …  
    185184      IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
    186185      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
    187       IF( lk_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
     186      IF( ln_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
    188187                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
    189188      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    190189                             CALL tra_ldf    ( kstp )       ! lateral mixing 
    191190#if defined key_agrif 
    192                              CALL tra_unswap 
    193191      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    194                              CALL tra_swap 
    195192#endif 
    196193                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields 
    … …  
    210207                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    211208      ENDIF  
    212                              CALL tra_unswap                ! udate T & S 3D arrays  (to be suppressed) 
    213  
    214       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    215       ! Dynamics                                    (ta, sa used as workspace) 
     209 
     210      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     211      ! Dynamics                                    (tsa used as workspace) 
    216212      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    217213                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    … …  
    250246 
    251247      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    252       ! Trends                              (ua, va, ta, sa used as workspace) 
     248      ! Trends                              (ua, va, tsa used as workspace) 
    253249      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    254250      IF( nstop == 0 ) THEN                          

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r2528 r2977  
    1717   USE daymod           ! calendar                         (day     routine) 
    1818 
    19    USE dtatem           ! ocean temperature data           (dta_tem routine) 
    20    USE dtasal           ! ocean salinity    data           (dta_sal routine) 
    2119   USE sbcmod           ! surface boundary condition       (sbc     routine) 
    2220   USE sbcrnf           ! surface boundary condition: runoff variables 
    … …  
    9290   USE prtctl           ! Print control                    (prt_ctl routine) 
    9391 
    94    USE traswp           ! Swap arrays           (tra_swp, tra_unswp routine) 
    95  
    9692   USE diaobs           ! Observation operator 
    9793 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r2528 r2977  
    108108      !                                              !* Test minimum of salinity 
    109109      !                                              !  ------------------------ 
    110       !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5 
     110      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5 
    111111      zsmin = 100.e0 
    112112      DO jj = 2, jpjm1 
    113113         DO ji = 1, jpi 
    114             IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1)) 
     114            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal)) 
    115115         END DO 
    116116      END DO 
    … …  
    121121      IF( zsmin < 0.) THEN  
    122122         IF (lk_mpp) THEN 
    123             CALL mpp_minloc ( sn(:,:,1),tmask(:,:,1), zsmin, ii,ij ) 
     123            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij ) 
    124124         ELSE 
    125             ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 ) 
     125            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 ) 
    126126            ii = ilocs(1) + nimpp - 1 
    127127            ij = ilocs(2) + njmpp - 1 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r2715 r2977  
    2525   REAL(wp), PUBLIC                                      ::   r_si2   !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB) 
    2626   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3   !: light absortion coefficient 
     27   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   facvol   !: volume for degraded regions 
    2728 
    2829#if defined key_top && defined key_pisces 
    … …  
    4849   !!---------------------------------------------------------------------- 
    4950   LOGICAL, PUBLIC, PARAMETER ::   lk_offline = .FALSE.   !: offline flag 
     51#endif 
     52#if defined key_degrad 
     53   !!---------------------------------------------------------------------- 
     54   !!   'key_degrad'                                     Degradation mode           
     55   !!---------------------------------------------------------------------- 
     56   LOGICAL, PUBLIC, PARAMETER ::   lk_degrad = .TRUE.   !: degradation flag 
     57#else 
     58   !!---------------------------------------------------------------------- 
     59   !!   Default option                                   NO  Degradation mode           
     60   !!---------------------------------------------------------------------- 
     61   LOGICAL, PUBLIC, PARAMETER ::   lk_degrad = .FALSE.   !: degradation flag 
    5062#endif 
    5163 
    … …  
    6375      !!                  ***  trc_oce_alloc  *** 
    6476      !!---------------------------------------------------------------------- 
    65       ALLOCATE( etot3(jpi,jpj,jpk)   , STAT= trc_oce_alloc ) 
     77      INTEGER ::   ierr(2)        ! Local variables 
     78      !!---------------------------------------------------------------------- 
     79      ierr(:) = 0 
     80                     ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) ) 
     81      IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) ) 
     82      trc_oce_alloc  = MAXVAL( ierr ) 
    6683      ! 
    6784      IF( trc_oce_alloc /= 0 )   CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r2749 r2977  
    169169      ALLOCATE( wrk_3d_1 (jpi,jpj,jpk) , wrk_3d_2 (jpi,jpj,jpk) , wrk_3d_3 (jpi,jpj,jpk) , wrk_3d_4 (jpi,jpj,jpk) ,     & 
    170170         &      wrk_3d_5 (jpi,jpj,jpk) , wrk_3d_6 (jpi,jpj,jpk) , wrk_3d_7 (jpi,jpj,jpk) , wrk_3d_8 (jpi,jpj,jpk) ,     & 
    171          &      wrk_3d_9 (jpi,jpj,jpk) , wrk_3d_10(jpi,jpj,jpk)                                                   ,     &  
    172          &      wrk_3d_11(jpi,jpj,jpk) , wrk_3d_12(jpi,jpj,jpk) , wrk_3d_13(jpi,jpj,jpk) , wrk_3d_14(jpi,jpj,jpk) ,     &  
    173          &      wrk_3d_15(jpi,jpj,jpk)                                                                            , STAT=ierror(3) ) 
     171         &      wrk_3d_9 (jpi,jpj,jpk) , wrk_3d_10(jpi,jpj,jpk) , wrk_3d_11(jpi,jpj,jpk) , wrk_3d_12(jpi,jpj,jpk) ,     &  
     172         &      wrk_3d_13(jpi,jpj,jpk) , wrk_3d_14(jpi,jpj,jpk) , wrk_3d_15(jpi,jpj,jpk)                          , STAT=ierror(3) ) 
    174173         ! 
    175174      ALLOCATE( wrk_4d_1(jpi,jpj,jpk,jpts) , wrk_4d_2(jpi,jpj,jpk,jpts),     & 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    r2715 r2977  
    5353      !!              COLUMN BELOW THE SURFACE LAYER. 
    5454      !!--------------------------------------------------------------------- 
     55      !! 
    5556      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    5657      !! 
    57       INTEGER  ::   ji, jj, jk, jl, ikt 
     58      INTEGER  ::   ji, jj, jk, jl, ikt, ierr 
    5859      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd 
    59       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio 
     60      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrbio 
    6061      CHARACTER (len=25) :: charout 
    6162      !!--------------------------------------------------------------------- 
    … …  
    6768      ENDIF 
    6869 
     70      IF( l_trdtrc )  THEN 
     71         ALLOCATE( ztrbio(jpi,jpj,jpk) , STAT = ierr )   ! temporary save of trends 
     72         IF( ierr > 0 ) THEN 
     73            CALL ctl_stop( 'trc_exp: unable to allocate ztrbio array' )   ;   RETURN 
     74         ENDIF 
     75         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) 
     76      ENDIF 
     77 
    6978      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 
    7079      ! POC IN THE WATER COLUMN 
    … …  
    7281      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_lobster.F90 
    7382      ! ---------------------------------------------------------------------- 
    74  
    75       IF( l_trdtrc )THEN 
    76          ALLOCATE( ztrbio(jpi,jpj,jpk) ) 
    77          ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) 
    78       ENDIF 
    79  
    8083      DO jk = 1, jpkm1 
    8184         DO jj = 2, jpjm1 
    … …  
    114117  
    115118      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example 
    116 #if defined key_diatrc 
    117 # if ! defined key_iomput 
    118       trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) 
    119 # else 
    120      CALL iom_put( "SEDPOC" , sedpocn ) 
    121 # endif 
    122 #endif 
     119      IF( ln_diatrc ) THEN 
     120         IF( lk_iomput ) THEN   ;   CALL iom_put( "SEDPOC" , sedpocn ) 
     121         ELSE                   ;   trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) 
     122         ENDIF 
     123      ENDIF 
    123124 
    124125       
    … …  
    146147         jl = jp_lob0_trd + 16 
    147148         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 
     149         DEALLOCATE( ztrbio )  
    148150      ENDIF 
    149  
    150       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    151151 
    152152      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

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

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

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

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

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

    r2715 r2977  
    4545      !! ** Method  : - ??? 
    4646      !! -------------------------------------------------------------------- 
    47       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    48       USE wrk_nemo, ONLY: ztrlob => wrk_3d_1   ! used for lobster sms trends 
    4947      !! 
    5048      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     49      ! 
    5150      INTEGER :: jn 
    5251      !! -------------------------------------------------------------------- 
    53  
    54       IF( wrk_in_use(3, 1) ) THEN 
    55          CALL ctl_stop('trc_sms_lobster : requested workspace array unavailable')   ;   RETURN 
    56       ENDIF 
    5752 
    5853      CALL trc_opt( kt )      ! optical model 
    … …  
    6257 
    6358      IF( l_trdtrc ) THEN 
    64           DO jn = jp_lob0, jp_lob1 
    65             ztrlob(:,:,:) = tra(:,:,:,jn) 
    66             CALL trd_mod_trc( ztrlob, jn, jptra_trd_sms, kt )   ! save trends 
    67           END DO 
     59         DO jn = jp_lob0, jp_lob1 
     60           CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
     61         END DO 
    6862      END IF 
    6963 
    7064      IF( lk_trdmld_trc )  CALL trd_mld_bio( kt )   ! trends: Mixed-layer 
    71  
    72       IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_lobster : failed to release workspace array.') 
    7365      ! 
    7466   END SUBROUTINE trc_sms_lobster 

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

    r2715 r2977  
    1414   !!                      compartments of PISCES 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce_trc         ! 
    17    USE trc         !  
    18    USE sms_pisces      !  
    19    USE p4zsink         !  
    20    USE p4zopt          !  
    21    USE p4zlim          !  
    22    USE p4zprod         ! 
    23    USE p4zmort         ! 
    24    USE p4zmicro        !  
    25    USE p4zmeso         !  
    26    USE p4zrem          !  
    27    USE prtctl_trc 
    28    USE iom 
     16   USE oce_trc         !  shared variables between ocean and passive tracers 
     17   USE trc             !  passive tracers common variables  
     18   USE sms_pisces      !  PISCES Source Minus Sink variables 
     19   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     20   USE p4zopt          !  optical model 
     21   USE p4zlim          !  Co-limitations of differents nutrients 
     22   USE p4zprod         !  Growth rate of the 2 phyto groups 
     23   USE p4zmort         !  Mortality terms for phytoplankton 
     24   USE p4zmicro        !  Sources and sinks of microzooplankton 
     25   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     26   USE p4zrem          !  Remineralisation of organic matter 
     27   USE prtctl_trc      !  print control for debugging 
     28   USE iom             !  I/O manager 
    2929   
    3030   IMPLICIT NONE 

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

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

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

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

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

    r2715 r2977  
    1313   !!   p4z_int        :  interpolation and computation of various accessory fields 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce_trc         ! 
    16    USE trc 
    17    USE sms_pisces 
     15   USE oce_trc         !  shared variables between ocean and passive tracers 
     16   USE trc             !  passive tracers common variables  
     17   USE sms_pisces      !  PISCES Source Minus Sink variables 
    1818 
    1919   IMPLICIT NONE 
    … …  
    2121 
    2222   PUBLIC   p4z_int   
    23    PUBLIC   p4z_int_alloc 
    24  
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    27  
    2823   REAL(wp) ::   xksilim = 16.5e-6_wp   ! Half-saturation constant for the Si half-saturation constant computation 
    2924 
    … …  
    4136      !! ** Purpose :   interpolation and computation of various accessory fields 
    4237      !! 
    43       !! ** Method  : - ??? 
    4438      !!--------------------------------------------------------------------- 
    45       INTEGER  ::   ji, jj 
    46       REAL(wp) ::   zdum 
     39      INTEGER  ::   ji, jj                 ! dummy loop indices 
     40      REAL(wp) ::   zvar                   ! local variable 
    4741      !!--------------------------------------------------------------------- 
    4842 
    … …  
    5751      DO ji = 1, jpi 
    5852         DO jj = 1, jpj 
    59             zdum = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 
    60             xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zdum / ( xksilim * xksilim + zdum ) ) * 1e-6 ) 
     53            zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 
     54            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
    6155         END DO 
    6256      END DO 
    … …  
    6862      ! 
    6963   END SUBROUTINE p4z_int 
    70  
    71  
    72    INTEGER FUNCTION p4z_int_alloc() 
    73       !!---------------------------------------------------------------------- 
    74       !!                     ***  ROUTINE p4z_int_alloc  *** 
    75       !!---------------------------------------------------------------------- 
    76       ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc ) 
    77       ! 
    78       IF( p4z_int_alloc /= 0 )   CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 
    79       ! 
    80    END FUNCTION p4z_int_alloc 
    8164 
    8265#else 

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

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

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

    r2715 r2977  
    99   !!             1.0  !  2004     (O. Aumont) modifications 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     11   !!                  !  2011-02  (J. Simeon, J. Orr)  Calcon salinity dependence 
     12   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improvment of calcite dissolution 
    1113   !!---------------------------------------------------------------------- 
    1214#if defined key_pisces 
    … …  
    1719   !!   p4z_lys_init   :   Read the namelist parameters 
    1820   !!---------------------------------------------------------------------- 
    19    USE trc 
    20    USE oce_trc         ! 
    21    USE trc 
    22    USE sms_pisces 
    23    USE prtctl_trc 
    24    USE iom 
     21   USE oce_trc         !  shared variables between ocean and passive tracers 
     22   USE trc             !  passive tracers common variables  
     23   USE sms_pisces      !  PISCES Source Minus Sink variables 
     24   USE prtctl_trc      !  print control for debugging 
     25   USE iom             !  I/O manager 
    2526 
    2627   IMPLICIT NONE 
    … …  
    6263      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6364      INTEGER  ::   ji, jj, jk, jn 
    64       REAL(wp) ::   zbot, zalk, zdic, zph, zremco3, zah2 
    65       REAL(wp) ::   zdispot, zfact, zalka 
     65      REAL(wp) ::   zalk, zdic, zph, zremco3, zah2 
     66      REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi 
    6667      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    67 #if defined key_diatrc && defined key_iomput 
    6868      REAL(wp) ::   zrfact2 
    69 #endif 
    7069      CHARACTER (len=25) :: charout 
    7170      !!--------------------------------------------------------------------- 
    … …  
    7574      END IF 
    7675 
    77       zco3(:,:,:) = 0. 
    78 # if defined key_diatrc && defined key_iomput 
     76      zco3    (:,:,:) = 0. 
    7977      zcaldiss(:,:,:) = 0. 
    80 # endif 
    8178      !     ------------------------------------------- 
    8279      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
    … …  
    9188!CDIR NOVERRCHK 
    9289               DO ji = 1, jpi 
    93  
    94                   ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    95                   zbot  = borat(ji,jj,jk) 
    96  
    97                   ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    98                   zbot  = borat(ji,jj,jk) 
    99                   zfact = rhop (ji,jj,jk) / 1000. + rtrn 
    100  
    101                   ! SET DUMMY VARIABLE FOR [H+] 
    102                   zph   = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 
    103  
    104                   ! SET DUMMY VARIABLE FOR [SUM(CO2)]GIVEN  
     90                  zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     91                  zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 
    10592                  zdic  = trn(ji,jj,jk,jpdic) / zfact 
    10693                  zalka = trn(ji,jj,jk,jptal) / zfact 
    107  
    10894                  ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    109                   zalk  = zalka - (  akw3(ji,jj,jk) / zph - zph   & 
    110                      &             + zbot / (1.+ zph / akb3(ji,jj,jk) )  ) 
    111  
     95                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 
    11296                  ! CALCULATE [H+] and [CO3--] 
    113                   zah2 = SQRT( (zdic-zalk)*(zdic-zalk)+   & 
    114                      &     4.*(zalk*ak23(ji,jj,jk)/ak13(ji,jj,jk))   & 
    115                      &     *(2*zdic-zalk)) 
    116  
    117                   zah2=0.5*ak13(ji,jj,jk)/zalk*((zdic-zalk)+zah2) 
    118                   zco3(ji,jj,jk) = zalk/(2.+zah2/ak23(ji,jj,jk))*zfact 
    119  
    120                   hi(ji,jj,jk)  = zah2*zfact 
    121  
     97                  zaldi = zdic - zalk 
     98                  zah2  = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 
     99                  zah2  = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 
     100                  ! 
     101                  zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 
     102                  hi(ji,jj,jk)   = zah2 * zfact 
    122103               END DO 
    123104            END DO 
    … …  
    137118 
    138119               ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    139                zomegaca = ( calcon * zco3(ji,jj,jk) ) / aksp(ji,jj,jk) 
     120               ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
     121               zcalcon  = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 
     122               zfact    = rhop(ji,jj,jk) / 1000._wp 
     123               zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk)  
    140124 
    141125               ! SET DEGREE OF UNDER-/SUPERSATURATION 
    142                zexcess0 = MAX( 0., ( 1.- zomegaca ) ) 
     126               excess(ji,jj,jk) = 1._wp - zomegaca 
     127               zexcess0 = MAX( 0., excess(ji,jj,jk) ) 
    143128               zexcess  = zexcess0**nca 
    144129 
    … …  
    146131               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    147132               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
     133               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 
    148134# if defined key_degrad 
    149               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) * facvol(ji,jj,jk) 
    150 # else 
    151               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 
     135               zdispot = zdispot * facvol(ji,jj,jk) 
    152136# endif 
    153  
    154137              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    155138              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    156               zremco3 = zdispot / rmtss 
    157               zco3(ji,jj,jk) = zco3(ji,jj,jk) + zremco3 * rfact 
    158               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zremco3 
    159               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zremco3 
    160               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zremco3 
    161  
    162 # if defined key_diatrc && defined key_iomput 
    163               zcaldiss(ji,jj,jk) = zremco3  ! calcite dissolution 
    164 # endif 
     139              zcaldiss(ji,jj,jk)  = zdispot / rmtss  ! calcite dissolution 
     140              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact 
     141              ! 
     142              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
     143              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk) 
     144              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk) 
    165145            END DO 
    166146         END DO 
    167147      END DO 
    168  
    169 # if defined key_diatrc 
    170 #  if ! defined key_iomput 
    171       trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
    172       trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)          * tmask(:,:,:) 
    173       trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 
    174 #  else 
    175       zrfact2 = 1.e3 * rfact2r 
    176       CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
    177       CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
    178       CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
    179       CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
    180 #  endif 
    181 # endif 
     148      ! 
     149      IF( ln_diatrc )  THEN 
     150         ! 
     151         IF( lk_iomput ) THEN 
     152            zrfact2 = 1.e3 * rfact2r 
     153            CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
     154            CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
     155            CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
     156            CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
     157         ELSE 
     158            trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
     159            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)          * tmask(:,:,:) 
     160            trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 
     161         ENDIF 
     162         ! 
     163      ENDIF 
    182164      ! 
    183165       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    207189      NAMELIST/nampiscal/ kdca, nca 
    208190 
    209       REWIND( numnat )                     ! read numnat 
    210       READ  ( numnat, nampiscal ) 
     191      REWIND( numnatp )                     ! read numnatp 
     192      READ  ( numnatp, nampiscal ) 
    211193 
    212194      IF(lwp) THEN                         ! control print 

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

    r2528 r2977  
    66   !! History :   1.0  !  2002     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
    … …  
    1415   !!   p4z_meso_init  :   Initialization of the parameters for mesozooplankton 
    1516   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE prtctl_trc 
    21    USE p4zint 
    22    USE p4zsink 
    23    USE iom 
     17   USE oce_trc         !  shared variables between ocean and passive tracers 
     18   USE trc             !  passive tracers common variables  
     19   USE sms_pisces      !  PISCES Source Minus Sink variables 
     20   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     21   USE p4zint          !  interpolation and computation of various fields 
     22   USE p4zprod         !  production 
     23   USE prtctl_trc      !  print control for debugging 
     24   USE iom             !  I/O manager 
    2425 
    2526   IMPLICIT NONE 
    … …  
    3031 
    3132   !! * Shared module variables 
    32    REAL(wp), PUBLIC ::   & 
    33       xprefc   = 1.0_wp     ,  &  !:  
    34       xprefp   = 0.2_wp     ,  &  !: 
    35       xprefz   = 1.0_wp     ,  &  !: 
    36       xprefpoc = 0.0_wp     ,  &  !: 
    37       resrat2  = 0.005_wp   ,  &  !: 
    38       mzrat2   = 0.03_wp    ,  &  !: 
    39       grazrat2 = 0.7_wp     ,  &  !: 
    40       xkgraz2  = 20E-6_wp   ,  &  !: 
    41       unass2   = 0.3_wp     ,  &  !: 
    42       sigma2   = 0.6_wp     ,  &  !: 
    43       epsher2  = 0.33_wp    ,  &  !:    
    44       grazflux = 5.E3_wp  
    45  
     33   REAL(wp), PUBLIC ::  part2       = 0.5_wp     !: part of calcite not dissolved in mesozoo guts 
     34   REAL(wp), PUBLIC ::  xprefc      = 1.0_wp     !: mesozoo preference for POC  
     35   REAL(wp), PUBLIC ::  xprefp      = 0.3_wp     !: mesozoo preference for nanophyto 
     36   REAL(wp), PUBLIC ::  xprefz      = 1.0_wp     !: mesozoo preference for diatoms 
     37   REAL(wp), PUBLIC ::  xprefpoc    = 0.3_wp     !: mesozoo preference for POC  
     38   REAL(wp), PUBLIC ::  xthresh2zoo = 1E-8_wp    !: zoo feeding threshold for mesozooplankton  
     39   REAL(wp), PUBLIC ::  xthresh2dia = 1E-8_wp    !: diatoms feeding threshold for mesozooplankton  
     40   REAL(wp), PUBLIC ::  xthresh2phy = 2E-7_wp    !: nanophyto feeding threshold for mesozooplankton  
     41   REAL(wp), PUBLIC ::  xthresh2poc = 1E-8_wp    !: poc feeding threshold for mesozooplankton  
     42   REAL(wp), PUBLIC ::  xthresh2    = 0._wp      !: feeding threshold for mesozooplankton  
     43   REAL(wp), PUBLIC ::  resrat2     = 0.005_wp   !: exsudation rate of mesozooplankton 
     44   REAL(wp), PUBLIC ::  mzrat2      = 0.04_wp    !: microzooplankton mortality rate  
     45   REAL(wp), PUBLIC ::  grazrat2    = 0.9_wp     !: maximal mesozoo grazing rate 
     46   REAL(wp), PUBLIC ::  xkgraz2     = 20E-6_wp   !: non assimilated fraction of P by mesozoo  
     47   REAL(wp), PUBLIC ::  unass2      = 0.3_wp     !: Efficicency of mesozoo growth  
     48   REAL(wp), PUBLIC ::  sigma2      = 0.6_wp     !: Fraction of mesozoo excretion as DOM  
     49   REAL(wp), PUBLIC ::  epsher2     = 0.3_wp     !: half sturation constant for grazing 2 
     50   REAL(wp), PUBLIC ::  grazflux    = 3.E3_wp    !: mesozoo flux feeding rate 
    4651 
    4752   !!* Substitution 
    … …  
    6570      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    6671      INTEGER  :: ji, jj, jk 
    67       REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 
    68       REAL(wp) :: zfact, zcompam, zdenom, zgraze2, zstep 
    69       REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 
     72      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
     73      REAL(wp) :: zgraze2 , zdenom, zdenom2, zncratio 
     74      REAL(wp) :: zfact   , zstep, zfood, zfoodlim 
     75      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf 
     76      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat 
    7077#if defined key_kriest 
    7178      REAL znumpoc 
    7279#endif 
    73       REAL(wp) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 
    74       REAL(wp) :: zgrazn,zgrazpoc,zgraznf,zgrazf 
    75       REAL(wp) :: zgrazfff,zgrazffe 
     80      REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof 
     81      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 
     82      REAL(wp) :: zgrazfff, zgrazffe 
    7683      CHARACTER (len=25) :: charout 
    77 #if defined key_diatrc && defined key_iomput 
    7884      REAL(wp) :: zrfact2 
    79 #endif 
    8085 
    8186      !!--------------------------------------------------------------------- 
    … …  
    8489         DO jj = 1, jpj 
    8590            DO ji = 1, jpi 
    86  
    87                zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
     91               zcompam   = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-8 ), 0.e0 ) 
    8892# if defined key_degrad 
    89                zstep   = xstep * facvol(ji,jj,jk) 
     93               zstep     = xstep * facvol(ji,jj,jk) 
    9094# else 
    91                zstep   = xstep 
     95               zstep     = xstep 
    9296# endif 
    93                zfact   = zstep * tgfunc(ji,jj,jk) * zcompam 
     97               zfact     = zstep * tgfunc(ji,jj,jk) * zcompam 
    9498 
    9599               !  Respiration rates of both zooplankton 
    96100               !  ------------------------------------- 
    97                zrespz2  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
    98                   &     * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 
     101               zrespz2   = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) )  & 
     102                  &      + resrat2 * zfact * 3. * nitrfac(ji,jj,jk) 
    99103 
    100104               !  Zooplankton mortality. A square function has been selected with 
    101105               !  no real reason except that it seems to be more stable and may mimic predation 
    102106               !  --------------------------------------------------------------- 
    103                ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
     107               ztortz2   = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
    104108               ! 
    105109 
    106                zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    107                zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
    108                zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 
    109                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
    110  
    111                !  Microzooplankton grazing 
    112                !     ------------------------ 
    113                zdenom = 1. / (  xkgraz2 + xprefc   * trn(ji,jj,jk,jpdia)   & 
    114                   &                     + xprefz   * trn(ji,jj,jk,jpzoo)   & 
    115                   &                     + xprefp   * trn(ji,jj,jk,jpphy)   & 
    116                   &                     + xprefpoc * trn(ji,jj,jk,jppoc)  ) 
    117  
    118                zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom * trn(ji,jj,jk,jpmes)  
    119  
    120                zgrazd   = zgraze2  * xprefc   * zcompadi 
    121                zgrazz   = zgraze2  * xprefz   * zcompaz 
    122                zgrazn   = zgraze2  * xprefp   * zcompaph 
    123                zgrazpoc = zgraze2  * xprefpoc * zcompapoc 
    124  
    125                zgraznf  = zgrazn   * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    126                zgrazf   = zgrazd   * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    127                zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    128                 
     110               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
     111               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
     112               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 
     113               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
     114 
     115               zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc  
     116               zfoodlim  = MAX( 0., zfood - xthresh2 ) 
     117               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
     118               zdenom2   = zdenom / ( zfood + rtrn ) 
     119               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes)  
     120 
     121               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2  
     122               zgrazz    = zgraze2  * xprefz   * zcompaz   * zdenom2  
     123               zgrazn    = zgraze2  * xprefp   * zcompaph  * zdenom2  
     124               zgrazpoc  = zgraze2  * xprefpoc * zcompapoc * zdenom2  
     125 
     126               zgraznf   = zgrazn   * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn) 
     127               zgrazf    = zgrazd   * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn) 
     128               zgrazpof  = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn) 
     129 
    129130               !  Mesozooplankton flux feeding on GOC 
    130131               !  ---------------------------------- 
    131132# if ! defined key_kriest 
    132                zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk)          & 
    133                   &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    134                zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
     133               zgrazffe  = grazflux * zstep * wsbio4(ji,jj,jk)          & 
     134                 &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
     135               zgrazfff  = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
    135136# else 
    136                !!--------------------------- KRIEST3 ------------------------------------------- 
    137                !!               zgrazffe = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
    138                !!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    & 
    139                !! #  if defined key_degrad 
    140                !!                  &     * facvol(ji,jj,jk)          & 
    141                !! #  endif 
    142                !!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 
    143                !!--------------------------- KRIEST3 ------------------------------------------- 
    144  
    145               zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
    146                   &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    147               zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     137               zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
     138               zgrazfff   = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    148139# endif 
    149        
    150 #if defined key_diatrc 
    151               ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
    152               grazing(ji,jj,jk) = grazing(ji,jj,jk) + (  zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) 
    153 #endif 
    154  
     140              ! 
     141              zgraztot   = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe 
     142              zgraztotf  = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff  
     143 
     144              ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
     145              grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 
    155146              !    Mesozooplankton efficiency 
    156147              !    -------------------------- 
    157               zgrarem2 = ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) * ( 1. - epsher2 - unass2 ) 
    158 #if ! defined key_kriest 
    159               zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1.- epsher2 - unass2 ) &  
    160                   &     + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    161                   &                 + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    162                   &                 + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    163                   &                 + zgrazffe * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  ) 
     148              zgrasrat   =  zgraztotf / ( zgraztot + rtrn ) 
     149              zncratio   = (  xprefc   * zcompadi * quotad(ji,jj,jk)  & 
     150                  &         + xprefp   * zcompaph * quotan(ji,jj,jk)  & 
     151                  &         + xprefz   * zcompaz                      & 
     152                  &         + xprefpoc * zcompapoc   ) / ( zfood + rtrn ) 
     153               zepshert  = epsher2 * MIN( 1., zncratio ) 
     154               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 ) 
     155               zgrarem2  = zgraztot * ( 1. - zepsherv - unass2 ) 
     156               zgrafer2  = zgraztot * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepshert )  
     157               zgrapoc2  = zgraztot * unass2 
     158 
     159               !   Update the arrays TRA which contain the biological sources and sinks 
     160               zgrarsig  = zgrarem2 * sigma2 
     161               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     162               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     163               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
     164               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
     165               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
     166               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     167               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
     168#if defined key_kriest 
     169               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 
     170               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso 
     171               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass2 
    164172#else 
    165               zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1. - epsher2 - unass2 ) & 
    166                   &    + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    167                   &                + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    168                   &                + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    169                   &                + zgrazffe * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  ) 
    170  
    171 #endif 
    172                !   Update the arrays TRA which contain the biological sources and sinks 
    173  
    174                zgrapoc2 =  zgrazd + zgrazz  + zgrazn + zgrazpoc + zgrazffe 
    175  
    176                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 
    177                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 
    178                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1. - sigma2 ) 
    179                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 
    180                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    181                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem2 * sigma2 
    182                 
    183 #if defined key_kriest 
    184                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 * unass2 
    185                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * unass2 * xkr_dmeso 
    186 #else 
    187                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 * unass2 
     173               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 
     174               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgraztotf * unass2 
    188175#endif 
    189176               zmortz2 = ztortz2 + zrespz2 
    190                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2 
     177               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + zepsherv * zgraztot  
    191178               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
    192179               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    … …  
    199186               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    200187 
    201                zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn 
    202 #if defined key_diatrc 
     188               zprcaca = xfracal(ji,jj,jk) * zgrazn 
     189               ! calcite production 
    203190               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    204 #endif 
    205                zprcaca = part * zprcaca 
     191               ! 
     192               zprcaca = part2 * zprcaca 
    206193               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    207194               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    … …  
    212199               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc & 
    213200                  &    + zmortz2  * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 
    214                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 
    215                &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff - zgrazpof 
     201               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 - zgrazfff - zgrazpof 
    216202#else 
    217203               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc 
    218204               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe 
    219205               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof 
    220                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 
    221                &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff 
     206               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 - zgrazfff 
    222207#endif 
    223208 
    … …  
    226211      END DO 
    227212      ! 
    228 #if defined key_diatrc && defined key_iomput 
    229       zrfact2 = 1.e3 * rfact2r 
    230       ! Total grazing of phyto by zoo 
    231       grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) 
    232       ! Calcite production 
    233       prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 
    234       IF( jnt == nrdttrc ) then  
    235          CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
    236          CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
     213      IF( ln_diatrc .AND. lk_iomput ) THEN 
     214         zrfact2 = 1.e3 * rfact2r 
     215         grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:)   ! Total grazing of phyto by zoo 
     216         prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:)   ! Calcite production 
     217         IF( jnt == nrdttrc ) THEN 
     218            CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
     219            CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
     220         ENDIF 
    237221      ENDIF 
    238 #endif 
    239  
    240        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    241          WRITE(charout, FMT="('meso')") 
    242          CALL prt_ctl_trc_info(charout) 
    243          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    244        ENDIF 
     222      ! 
     223      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     224        WRITE(charout, FMT="('meso')") 
     225        CALL prt_ctl_trc_info(charout) 
     226        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     227      ENDIF 
    245228 
    246229   END SUBROUTINE p4z_meso 
    … …  
    260243      !!---------------------------------------------------------------------- 
    261244 
    262       NAMELIST/nampismes/ grazrat2,resrat2,mzrat2,xprefc, xprefp, & 
    263          &             xprefz, xprefpoc, xkgraz2, epsher2, sigma2, unass2, grazflux 
    264  
    265       REWIND( numnat )                     ! read numnat 
    266       READ  ( numnat, nampismes ) 
     245      NAMELIST/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   & 
     246         &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 
     247         &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux 
     248 
     249      REWIND( numnatp )                     ! read numnatp 
     250      READ  ( numnatp, nampismes ) 
    267251 
    268252 
    … …  
    271255         WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes' 
    272256         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    273          WRITE(numout,*) '    zoo preference for phyto                  xprefc    =', xprefc 
    274          WRITE(numout,*) '    zoo preference for POC                    xprefp    =', xprefp 
    275          WRITE(numout,*) '    zoo preference for zoo                    xprefz    =', xprefz 
    276          WRITE(numout,*) '    zoo preference for poc                    xprefpoc  =', xprefpoc 
    277          WRITE(numout,*) '    exsudation rate of mesozooplankton        resrat2   =', resrat2 
    278          WRITE(numout,*) '    mesozooplankton mortality rate            mzrat2    =', mzrat2 
    279          WRITE(numout,*) '    maximal mesozoo grazing rate              grazrat2  =', grazrat2 
    280          WRITE(numout,*) '    mesozoo flux feeding rate                 grazflux  =', grazflux 
    281          WRITE(numout,*) '    non assimilated fraction of P by mesozoo  unass2    =', unass2 
    282          WRITE(numout,*) '    Efficicency of Mesozoo growth             epsher2   =', epsher2 
    283          WRITE(numout,*) '    Fraction of mesozoo excretion as DOM      sigma2    =', sigma2 
    284          WRITE(numout,*) '    half sturation constant for grazing 2     xkgraz2   =', xkgraz2 
     257         WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2 
     258         WRITE(numout,*) '    mesozoo preference for phyto                   xprefc       =', xprefc 
     259         WRITE(numout,*) '    mesozoo preference for POC                     xprefp       =', xprefp 
     260         WRITE(numout,*) '    mesozoo preference for zoo                     xprefz       =', xprefz 
     261         WRITE(numout,*) '    mesozoo preference for poc                     xprefpoc     =', xprefpoc 
     262         WRITE(numout,*) '    microzoo feeding threshold  for mesozoo        xthresh2zoo  =', xthresh2zoo 
     263         WRITE(numout,*) '    diatoms feeding threshold  for mesozoo         xthresh2dia  =', xthresh2dia 
     264         WRITE(numout,*) '    nanophyto feeding threshold for mesozoo        xthresh2phy  =', xthresh2phy 
     265         WRITE(numout,*) '    poc feeding threshold for mesozoo              xthresh2poc  =', xthresh2poc 
     266         WRITE(numout,*) '    feeding threshold for mesozooplankton          xthresh2     =', xthresh2 
     267         WRITE(numout,*) '    exsudation rate of mesozooplankton             resrat2      =', resrat2 
     268         WRITE(numout,*) '    mesozooplankton mortality rate                 mzrat2       =', mzrat2 
     269         WRITE(numout,*) '    maximal mesozoo grazing rate                   grazrat2     =', grazrat2 
     270         WRITE(numout,*) '    mesozoo flux feeding rate                      grazflux     =', grazflux 
     271         WRITE(numout,*) '    non assimilated fraction of P by mesozoo       unass2       =', unass2 
     272         WRITE(numout,*) '    Efficicency of Mesozoo growth                  epsher2      =', epsher2 
     273         WRITE(numout,*) '    Fraction of mesozoo excretion as DOM           sigma2       =', sigma2 
     274         WRITE(numout,*) '    half sturation constant for grazing 2          xkgraz2      =', xkgraz2 
    285275      ENDIF 
    286276 

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

    r2528 r2977  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
    … …  
    1415   !!   p4z_micro_init  :   Initialize and read the appropriate namelist 
    1516   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE prtctl_trc 
    21    USE p4zint 
    22    USE p4zsink 
    23    USE iom 
     17   USE oce_trc         !  shared variables between ocean and passive tracers 
     18   USE trc             !  passive tracers common variables  
     19   USE sms_pisces      !  PISCES Source Minus Sink variables 
     20   USE p4zlim          !  Co-limitations 
     21   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     22   USE p4zint          !  interpolation and computation of various fields 
     23   USE p4zprod         !  production 
     24   USE prtctl_trc      !  print control for debugging 
    2425 
    2526   IMPLICIT NONE 
    … …  
    2829   PUBLIC   p4z_micro         ! called in p4zbio.F90 
    2930   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90 
     31   PUBLIC   p4z_micro_alloc    ! called in trcsms_pisces.F90 
    3032 
    3133   !! * Shared module variables 
    32    REAL(wp), PUBLIC ::   & 
    33       xpref2c = 0.0_wp       ,  &  !: 
    34       xpref2p = 0.5_wp       ,  &  !: 
    35       xpref2d = 0.5_wp       ,  &  !: 
    36       resrat  = 0.03_wp      ,  &  !: 
    37       mzrat   = 0.0_wp       ,  &  !: 
    38       grazrat = 4.0_wp       ,  &  !: 
    39       xkgraz  = 20E-6_wp     ,  &  !: 
    40       unass   = 0.3_wp       ,  &  !: 
    41       sigma1  = 0.6_wp       ,  &  !: 
    42       epsher  = 0.33_wp 
     34   REAL(wp), PUBLIC ::  part       = 0.5_wp     !: part of calcite not dissolved in microzoo guts 
     35   REAL(wp), PUBLIC ::  xpref2c    = 0.2_wp     !: microzoo preference for POC  
     36   REAL(wp), PUBLIC ::  xpref2p    = 1.0_wp     !: microzoo preference for nanophyto 
     37   REAL(wp), PUBLIC ::  xpref2d    = 0.6_wp     !: microzoo preference for diatoms 
     38   REAL(wp), PUBLIC ::  xthreshdia = 1E-8_wp    !: diatoms feeding threshold for microzooplankton  
     39   REAL(wp), PUBLIC ::  xthreshphy = 2E-7_wp    !: nanophyto threshold for microzooplankton  
     40   REAL(wp), PUBLIC ::  xthreshpoc = 1E-8_wp    !: poc threshold for microzooplankton  
     41   REAL(wp), PUBLIC ::  xthresh    = 0._wp      !: feeding threshold for microzooplankton  
     42   REAL(wp), PUBLIC ::  resrat     = 0.03_wp    !: exsudation rate of microzooplankton 
     43   REAL(wp), PUBLIC ::  mzrat      = 0.0_wp     !: microzooplankton mortality rate  
     44   REAL(wp), PUBLIC ::  grazrat    = 3.0_wp     !: maximal microzoo grazing rate 
     45   REAL(wp), PUBLIC ::  xkgraz     = 20E-6_wp   !: non assimilated fraction of P by microzoo  
     46   REAL(wp), PUBLIC ::  unass      = 0.3_wp     !: Efficicency of microzoo growth  
     47   REAL(wp), PUBLIC ::  sigma1     = 0.6_wp     !: Fraction of microzoo excretion as DOM  
     48   REAL(wp), PUBLIC ::  epsher     = 0.3_wp     !: half sturation constant for grazing 1  
    4349 
    4450 
    … …  
    6369      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6470      INTEGER  :: ji, jj, jk 
    65       REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 
    66       REAL(wp) :: zgraze  , zdenom  , zdenom2, zstep 
    67       REAL(wp) :: zfact   , zinano , zidiat, zipoc 
     71      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc 
     72      REAL(wp) :: zgraze  , zdenom, zdenom2, zncratio 
     73      REAL(wp) :: zfact   , zstep, zfood, zfoodlim 
     74      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf 
    6875      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    69       REAL(wp) :: zrespz, ztortz 
     76      REAL(wp) :: zrespz, ztortz, zgrasrat 
    7077      REAL(wp) :: zgrazp, zgrazm, zgrazsd 
    7178      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 
    … …  
    7481      !!--------------------------------------------------------------------- 
    7582 
    76  
    77 #if defined key_diatrc 
    78       grazing(:,:,:) = 0.  !: Initialisation of  grazing 
    79 #endif 
    80  
    81       zstep = rfact2 / rday      ! Time step duration for biology 
    82  
     83      grazing(:,:,:) = 0.  !: grazing set to zero 
    8384      DO jk = 1, jpkm1 
    8485         DO jj = 1, jpj 
    8586            DO ji = 1, jpi 
    86                zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
     87               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
     88               zstep   = xstep 
    8789# if defined key_degrad 
    88                zstep   = xstep * facvol(ji,jj,jk) 
    89 # else 
    90                zstep   = xstep 
     90               zstep = zstep * facvol(ji,jj,jk) 
    9191# endif 
    92                zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz 
     92               zfact   = zstep * tgfunc2(ji,jj,jk) * zcompaz 
    9393 
    9494               !  Respiration rates of both zooplankton 
    9595               !  ------------------------------------- 
    96                zrespz = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
    97                   &            * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 
     96               zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( 2. * xkmort + trn(ji,jj,jk,jpzoo) )  & 
     97                  &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    9898 
    9999               !  Zooplankton mortality. A square function has been selected with 
    … …  
    102102               ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
    103103 
    104                zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    105                zcompadi2 = MIN( zcompadi, 5.e-7 ) 
    106                zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 
    107                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
     104               zcompadi  = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
     105               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
     106               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    108107                
    109108               !     Microzooplankton grazing 
    110109               !     ------------------------ 
    111                zdenom2 = 1./ ( xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi2 + rtrn ) 
    112  
    113                zgraze = grazrat * zstep * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 
    114  
    115                zinano = xpref2p * zcompaph  * zdenom2 
    116                zipoc  = xpref2c * zcompapoc * zdenom2 
    117                zidiat = xpref2d * zcompadi2 * zdenom2 
    118  
    119                zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 
    120  
    121                zgrazp  = zgraze * zinano * zcompaph * zdenom 
    122                zgrazm  = zgraze * zipoc  * zcompapoc * zdenom 
    123                zgrazsd = zgraze * zidiat * zcompadi2 * zdenom 
    124  
    125                zgrazpf = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    126                zgrazmf = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    127                zgrazsf = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    128 #if defined key_diatrc 
     110               zfood     = xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi 
     111               zfoodlim  = MAX( 0. , zfood - xthresh ) 
     112               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
     113               zdenom2   = zdenom / ( zfood + rtrn ) 
     114               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo)  
     115 
     116               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2  
     117               zgrazm    = zgraze  * xpref2c * zcompapoc * zdenom2  
     118               zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2  
     119 
     120               zgrazpf   = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
     121               zgrazmf   = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     122               zgrazsf   = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     123               ! 
     124               zgraztot  = zgrazp  + zgrazm  + zgrazsd  
     125               zgraztotf = zgrazpf + zgrazsf + zgrazmf  
     126 
    129127               ! Grazing by microzooplankton 
    130                grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd  
    131 #endif 
     128               grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 
    132129 
    133130               !    Various remineralization and excretion terms 
    134131               !    -------------------------------------------- 
    135                zgrarem = ( zgrazp + zgrazm + zgrazsd ) * ( 1.- epsher - unass ) 
    136                zgrafer = ( zgrazpf + zgrazsf + zgrazmf ) * ( 1.- epsher - unass ) & 
    137                   &      + epsher * ( zgrazm  * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) &  
    138                   &                 + zgrazp  * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 
    139                   &                 + zgrazsd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  ) 
    140  
    141                zgrapoc = (  zgrazp + zgrazm + zgrazsd )  
     132               zgrasrat  = zgraztotf / ( zgraztot + rtrn ) 
     133               zncratio  = ( xpref2p * zcompaph * quotan(ji,jj,jk) & 
     134                  &        + xpref2d * zcompadi * quotad(ji,jj,jk) + xpref2c * zcompapoc ) / ( zfood + rtrn ) 
     135               zepshert  = epsher * MIN( 1., zncratio ) 
     136               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 ) 
     137               zgrafer   = zgraztot * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepshert )  
     138               zgrarem   = zgraztot * ( 1. - zepsherv - unass ) 
     139               zgrapoc   = zgraztot * unass 
    142140 
    143141               !  Update of the TRA arrays 
    144142               !  ------------------------ 
    145  
    146                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem * sigma1 
    147                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem * sigma1 
    148                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem * (1.-sigma1) 
    149                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 
     143               zgrarsig  = zgrarem * sigma1 
     144               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     145               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     146               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
     147               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    150148               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    151                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc * unass 
    152                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 
     149               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     150               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
     151               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     152               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
    153153#if defined key_kriest 
    154                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass * xkr_ddiat 
     154               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat 
    155155#endif 
    156  
    157                ! 
    158156               !   Update the arrays TRA which contain the biological sources and sinks 
    159157               !   -------------------------------------------------------------------- 
    160  
    161158               zmortz = ztortz + zrespz 
    162                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc  
     159               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztot  
    163160               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
    164161               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
    … …  
    170167               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    171168               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
    172                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz + unass * ( zgrazpf + zgrazsf ) - (1.-unass) * zgrazmf 
    173                zprcaca = xfracal(ji,jj,jk) * unass * zgrazp 
    174 #if defined key_diatrc 
     169               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
     170               zprcaca = xfracal(ji,jj,jk) * zgrazp 
     171               ! 
     172               ! calcite production 
    175173               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    176 #endif 
     174               ! 
    177175               zprcaca = part * zprcaca 
    178176               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    … …  
    203201      !! 
    204202      !! ** Method  :   Read the nampiszoo namelist and check the parameters 
    205       !!      called at the first timestep (nit000) 
     203      !!                called at the first timestep (nit000) 
    206204      !! 
    207205      !! ** input   :   Namelist nampiszoo 
    … …  
    209207      !!---------------------------------------------------------------------- 
    210208 
    211       NAMELIST/nampiszoo/ grazrat,resrat,mzrat,xpref2c, xpref2p, & 
    212          &             xpref2d, xkgraz, epsher, sigma1, unass 
    213  
    214       REWIND( numnat )                     ! read numnat 
    215       READ  ( numnat, nampiszoo ) 
     209      NAMELIST/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 
     210         &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, & 
     211         &                xthresh, xkgraz, epsher, sigma1, unass 
     212 
     213      REWIND( numnatp )                     ! read numnatp 
     214      READ  ( numnatp, nampiszoo ) 
    216215 
    217216      IF(lwp) THEN                         ! control print 
    … …  
    219218         WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo' 
    220219         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    221          WRITE(numout,*) '    zoo preference for POC                    xpref2c    =', xpref2c 
    222          WRITE(numout,*) '    zoo preference for nano                   xpref2p    =', xpref2p 
    223          WRITE(numout,*) '    zoo preference for diatoms                xpref2d    =', xpref2d 
    224          WRITE(numout,*) '    exsudation rate of microzooplankton       resrat    =', resrat 
    225          WRITE(numout,*) '    microzooplankton mortality rate           mzrat     =', mzrat 
    226          WRITE(numout,*) '    maximal microzoo grazing rate             grazrat   =', grazrat 
    227          WRITE(numout,*) '    non assimilated fraction of P by microzoo unass     =', unass 
    228          WRITE(numout,*) '    Efficicency of microzoo growth            epsher    =', epsher 
    229          WRITE(numout,*) '    Fraction of microzoo excretion as DOM     sigma1    =', sigma1 
    230          WRITE(numout,*) '    half sturation constant for grazing 1     xkgraz    =', xkgraz 
     220         WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part 
     221         WRITE(numout,*) '    microzoo preference for POC                     xpref2c     =', xpref2c 
     222         WRITE(numout,*) '    microzoo preference for nano                    xpref2p     =', xpref2p 
     223         WRITE(numout,*) '    microzoo preference for diatoms                 xpref2d     =', xpref2d 
     224         WRITE(numout,*) '    diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia 
     225         WRITE(numout,*) '    nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy 
     226         WRITE(numout,*) '    poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc 
     227         WRITE(numout,*) '    feeding threshold for microzooplankton          xthresh     =', xthresh 
     228         WRITE(numout,*) '    exsudation rate of microzooplankton             resrat      =', resrat 
     229         WRITE(numout,*) '    microzooplankton mortality rate                 mzrat       =', mzrat 
     230         WRITE(numout,*) '    maximal microzoo grazing rate                   grazrat     =', grazrat 
     231         WRITE(numout,*) '    non assimilated fraction of P by microzoo       unass       =', unass 
     232         WRITE(numout,*) '    Efficicency of microzoo growth                  epsher      =', epsher 
     233         WRITE(numout,*) '    Fraction of microzoo excretion as DOM           sigma1      =', sigma1 
     234         WRITE(numout,*) '    half sturation constant for grazing 1           xkgraz      =', xkgraz 
    231235      ENDIF 
    232236 
    233237   END SUBROUTINE p4z_micro_init 
     238 
     239   INTEGER FUNCTION p4z_micro_alloc() 
     240      !!---------------------------------------------------------------------- 
     241      !!                     ***  ROUTINE p4z_micro_alloc  *** 
     242      !!---------------------------------------------------------------------- 
     243      ALLOCATE( grazing(jpi,jpj,jpk), STAT=p4z_micro_alloc ) 
     244      IF( p4z_micro_alloc /= 0 ) CALL ctl_warn('p4z_micro_alloc : failed to allocate arrays.') 
     245 
     246   END FUNCTION p4z_micro_alloc 
    234247 
    235248#else 

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

    r2528 r2977  
    1414   !!   p4z_mort_init  :   Initialize the mortality params for phytoplankton 
    1515   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE p4zsink 
    21    USE prtctl_trc 
     16   USE oce_trc         !  shared variables between ocean and passive tracers 
     17   USE trc             !  passive tracers common variables  
     18   USE sms_pisces      !  PISCES Source Minus Sink variables 
     19   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     20   USE prtctl_trc      !  print control for debugging 
    2221 
    2322   IMPLICIT NONE 
    … …  
    2625   PUBLIC   p4z_mort     
    2726   PUBLIC   p4z_mort_init     
    28  
     27   PUBLIC   p4z_mort_alloc     
    2928 
    3029   !! * Shared module variables 
    31    REAL(wp), PUBLIC ::   & 
    32      wchl   = 0.001_wp    ,  &  !: 
    33      wchld  = 0.02_wp     ,  &  !: 
    34      mprat  = 0.01_wp     ,  &  !: 
    35      mprat2 = 0.01_wp     ,  &  !: 
    36      mpratm = 0.01_wp           !: 
     30   REAL(wp), PUBLIC :: wchl   = 0.001_wp  !: 
     31   REAL(wp), PUBLIC :: wchld  = 0.02_wp   !: 
     32   REAL(wp), PUBLIC :: mprat  = 0.01_wp   !: 
     33   REAL(wp), PUBLIC :: mprat2 = 0.01_wp   !: 
     34   REAL(wp), PUBLIC :: mpratm = 0.01_wp   !: 
    3735 
    3836 
    … …  
    8179      !!--------------------------------------------------------------------- 
    8280 
    83  
    84 #if defined key_diatrc 
    85      prodcal(:,:,:) = 0.  !: Initialisation of calcite production variable 
    86 #endif 
    87  
     81      prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
    8882      DO jk = 1, jpkm1 
    8983         DO jj = 1, jpj 
    9084            DO ji = 1, jpi 
    91  
    9285               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    93  
     86               zstep    = xstep 
    9487# if defined key_degrad 
    95                zstep =  xstep * facvol(ji,jj,jk)   
    96 # else 
    97                zstep =  xstep   
     88               zstep    = zstep * facvol(ji,jj,jk) 
    9889# endif 
    9990               !     Squared mortality of Phyto similar to a sedimentation term during 
    … …  
    117108               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
    118109               zprcaca = xfracal(ji,jj,jk) * zmortp 
    119 #if defined key_diatrc 
     110               ! 
    120111               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    121 #endif 
     112               ! 
    122113               zfracal = 0.5 * xfracal(ji,jj,jk) 
    123114               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    … …  
    177168               !    sticky and coagulate to sink quickly out of the euphotic zone 
    178169               !     ------------------------------------------------------------ 
    179  
     170               zstep   = xstep 
    180171# if defined key_degrad 
    181                zstep =  xstep * facvol(ji,jj,jk)   
    182 # else 
    183                zstep =  xstep   
     172               zstep = zstep * facvol(ji,jj,jk) 
    184173# endif 
    185174               !  Phytoplankton respiration  
    … …  
    243232      NAMELIST/nampismort/ wchl, wchld, mprat, mprat2, mpratm 
    244233 
    245       REWIND( numnat )                     ! read numnat 
    246       READ  ( numnat, nampismort ) 
     234      REWIND( numnatp )                     ! read numnatp 
     235      READ  ( numnatp, nampismort ) 
    247236 
    248237      IF(lwp) THEN                         ! control print 

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

    r2715 r2977  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation 
     9   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat 
    910   !!---------------------------------------------------------------------- 
    1011#if defined  key_pisces 
    … …  
    1718   USE oce_trc        ! tracer-ocean share variables 
    1819   USE sms_pisces     ! Source Minus Sink of PISCES 
    19    USE iom 
     20   USE iom            ! I/O manager 
    2021 
    2122   IMPLICIT NONE 
    … …  
    5354      !!--------------------------------------------------------------------- 
    5455      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    55       USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 
    56       USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr  => wrk_3d_3 , zekb => wrk_3d_4 
    57       USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1   => wrk_3d_6 
    58       USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3   => wrk_3d_8 
     56      USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp  => wrk_2d_2 
     57      USE wrk_nemo, ONLY:   zetmp1  => wrk_2d_3 , zetmp2 => wrk_2d_4 
     58      USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr   => wrk_3d_3 , zekb => wrk_3d_4 
     59      USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1    => wrk_3d_6 
     60      USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3    => wrk_3d_8 
    5961      ! 
    6062      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step 
    … …  
    6365      INTEGER  ::   irgb 
    6466      REAL(wp) ::   zchl, zxsi0r 
    65       REAL(wp) ::   zc0 , zc1 , zc2, zc3 
     67      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
    6668      !!--------------------------------------------------------------------- 
    6769 
    68       IF(  wrk_in_use(2, 1,2)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
     70      IF(  wrk_in_use(2, 1,2,3,4)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
    6971         CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')   ;   RETURN 
    7072      ENDIF 
    … …  
    8385            DO ji = 1, jpi 
    8486               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
    85                zchl = MIN(  10. , MAX( 0.03, zchl )  ) 
     87               zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    8688               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    8789               !                                                          
    … …  
    9294         END DO 
    9395      END DO 
    94  
    95 !!gm  Potential BUG  must discuss with Olivier about this implementation.... 
    96 !!gm           the questions are : - PAR at T-point or mean PAR over T-level.... 
    97 !!gm                               - shallow water: no penetration of light through the bottom.... 
    9896 
    9997 
    … …  
    145143         etot3(:,:,1) =          qsr(:,:) * tmask(:,:,1) 
    146144         ! 
    147          DO jk = 2, nksrp+1 
     145         DO jk = 2, nksrp + 1 
    148146!CDIR NOVERRCHK 
    149147            DO jj = 1, jpj 
    … …  
    188186      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    189187      zetmp  (:,:)   = 0.e0 
    190       emoy   (:,:,:) = 0.e0 
     188      zetmp1 (:,:)   = 0.e0 
     189      zetmp2 (:,:)   = 0.e0 
    191190 
    192191      DO jk = 1, nksrp 
    … …  
    196195            DO ji = 1, jpi 
    197196               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    198                   zetmp  (ji,jj) = zetmp  (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk) 
     197                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 
     198                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 
     199                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 
    199200                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 
    200201               ENDIF 
    … …  
    210211!CDIR NOVERRCHK 
    211212            DO ji = 1, jpi 
    212                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) )   emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
    213             END DO 
    214          END DO 
    215       END DO 
    216  
    217 #if defined key_diatrc 
    218 # if ! defined key_iomput 
    219       ! save for outputs 
    220       trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
    221       trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
    222 # else 
    223       ! write diagnostics  
    224       IF( jnt == nrdttrc ) then  
    225          CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
    226          CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     213               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     214                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     215                  emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 
     216                  enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     217                  ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     218               ENDIF 
     219            END DO 
     220         END DO 
     221      END DO 
     222 
     223      IF( ln_diatrc ) THEN        ! save output diagnostics 
     224        ! 
     225        IF( lk_iomput ) THEN 
     226           IF( jnt == nrdttrc ) THEN 
     227              CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
     228              CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     229           ENDIF 
     230        ELSE 
     231           trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
     232           trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
     233        ENDIF 
     234        ! 
    227235      ENDIF 
    228 # endif 
    229 #endif 
    230       ! 
    231       IF(  wrk_not_released(2, 1,2)           .OR.   & 
    232            wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
     236      ! 
     237      IF( wrk_not_released(2, 1,2,3,4)           .OR.   & 
     238          wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
    233239      ! 
    234240   END SUBROUTINE p4z_opt 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/TOOLS/COMPILE/cfg.txt

    r2413 r2977  
    66ORCA2_LIM3 OPA_SRC LIM_SRC_3 
    77ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
     8ORCA2_LIM_CFC OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     9ORCA2_OFF_CFC OPA_SRC OFF_SRC TOP_SRC 
Note: See TracChangeset for help on using the changeset viewer.