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 6639 for branches/UKMO/dev_r5518_RH_MEDUSA_Stable – NEMO

Ignore:
Timestamp:
2016-05-27T14:58:40+02:00 (8 years ago)
Author:
frrh
Message:

Merge NERC/dev_r5518_NOC_MEDUSA_Stable rev 5736 to 6509 inclusive

Location:
branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM
Files:
1 deleted
32 edited
17 copied

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/CONFIG/cfg.txt

    r6636 r6639  
    1111ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    1212ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
     13ORCA2_OFF_MEDUSA OPA_SRC OFF_SRC TOP_SRC 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r6636 r6639  
    445445      !                                     ! Passive tracers 
    446446                            CALL     trc_init 
     447# if defined key_debug_medusa 
     448      IF(lwp) WRITE(numout,*) '--nemo_init : trc_init OK --  next DIAGNOSTICS -- ' 
     449      CALL flush(numout) 
     450# endif 
    447451#endif 
    448452      !                                     ! Diagnostics 
     453# if defined key_debug_medusa 
     454      IF(lwp) WRITE(numout,*) '--nemo_init : Begins Diag inits --  next flo_init if lk_floats -- ' 
     455      CALL flush(numout) 
     456# endif 
    449457      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
     458# if defined key_debug_medusa 
     459      IF(lwp) WRITE(numout,*) '--nemo_init : flo_init OK --  next dia_ar5_init if lk_diaar5 -- ' 
     460      CALL flush(numout) 
     461# endif 
    450462      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
     463# if defined key_debug_medusa 
     464      IF(lwp) WRITE(numout,*) '--nemo_init : dia_ar5_init OK --  next dia_ptr_init -- ' 
     465      CALL flush(numout) 
     466# endif 
    451467                            CALL dia_ptr_init   ! Poleward TRansports initialization 
     468# if defined key_debug_medusa 
     469      IF(lwp) WRITE(numout,*) '--nemo_init : dia_ptr_init OK --  next dia_dct_init if lk_diadct -- ' 
     470      CALL flush(numout) 
     471# endif 
    452472      IF( lk_diadct     )   CALL dia_dct_init   ! Sections tranports 
     473# if defined key_debug_medusa 
     474      IF(lwp) WRITE(numout,*) '--nemo_init : dia_dct_init OK --  next dia_hsb_init -- ' 
     475      CALL flush(numout) 
     476# endif 
    453477                            CALL dia_hsb_init   ! heat content, salt content and volume budgets 
     478# if defined key_debug_medusa 
     479      IF(lwp) WRITE(numout,*) '--nemo_init : dia_hsb_init OK --  next trd_init -- ' 
     480      CALL flush(numout) 
     481# endif 
    454482                            CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends 
     483# if defined key_debug_medusa 
     484      IF(lwp) WRITE(numout,*) '--nemo_init : trd_init OK --  next dia_obs_init if lk_diaobs -- ' 
     485      CALL flush(numout) 
     486# endif 
    455487      IF( lk_diaobs     ) THEN                  ! Observation & model comparison 
    456488                            CALL dia_obs_init            ! Initialize observational data 
     489# if defined key_debug_medusa 
     490           IF(lwp) WRITE(numout,*) '--nemo_init : dia_obs_init OK -- dia_obs if lk_diaobs -- ' 
     491           CALL flush(numout) 
     492# endif 
    457493                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    458494      ENDIF 
    459  
     495# if defined key_debug_medusa 
     496      IF(lwp) WRITE(numout,*) '--nemo_init : dia_obs OK --  next asm_inc_init if lk_asminc -- ' 
     497      CALL flush(numout) 
     498# endif 
    460499      !                                     ! Assimilation increments 
    461500      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    462501      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
     502      ! 
     503# if defined key_debug_medusa 
     504      IF(lwp) WRITE(numout,*) '--nemo_init - Done - OK  -- ' 
     505      CALL flush(numout) 
     506# endif 
    463507      ! 
    464508   END SUBROUTINE nemo_init 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    r6636 r6639  
    1111   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    1212 
     13   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA 
     14   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA 
     15   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA 
     16   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA 
     17 
     18   USE par_idtra  , ONLY : jp_idtra        !: number of tracers in MEDUSA 
     19   USE par_idtra  , ONLY : jp_idtra_2d     !: number of tracers in MEDUSA 
     20   USE par_idtra  , ONLY : jp_idtra_3d     !: number of tracers in MEDUSA 
     21   USE par_idtra  , ONLY : jp_idtra_trd    !: number of tracers in MEDUSA 
     22 
    1323   USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC 
    1424   USE par_cfc    , ONLY : jp_cfc_2d       !: number of 2D diag in CFC 
    … …  
    1929   IMPLICIT NONE 
    2030 
    21    INTEGER, PARAMETER ::   jp_lb      =  jp_pisces     + jp_cfc     !: cum. number of pass. tracers 
    22    INTEGER, PARAMETER ::   jp_lb_2d   =  jp_pisces_2d  + jp_cfc_2d  !: 
    23    INTEGER, PARAMETER ::   jp_lb_3d   =  jp_pisces_3d  + jp_cfc_3d  !: 
    24    INTEGER, PARAMETER ::   jp_lb_trd  =  jp_pisces_trd + jp_cfc_trd !: 
     31   INTEGER, PARAMETER ::   jp_lb      =  jp_pisces     + jp_medusa     +   & 
     32                      jp_idtra      + jp_cfc                               !: cum. number of pass. tracers 
     33   INTEGER, PARAMETER ::   jp_lb_2d   =  jp_pisces_2d  + jp_medusa_2d  +   & 
     34                      jp_idtra_2d   + jp_cfc_2d  !: 
     35   INTEGER, PARAMETER ::   jp_lb_3d   =  jp_pisces_3d  + jp_medusa_3d  +   & 
     36                      jp_idtra_3d   + jp_cfc_3d  !: 
     37   INTEGER, PARAMETER ::   jp_lb_trd  =  jp_pisces_trd + jp_medusa_trd +   & 
     38                      jp_idtra_trd  + jp_cfc_trd !: 
    2539    
    2640#if defined key_c14b 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r6636 r6639  
    1515   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    1616 
     17   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA 
     18   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA 
     19   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA 
     20   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA 
     21 
     22   USE par_idtra  , ONLY : jp_idtra        !: number of tracers in MEDUSA 
     23   USE par_idtra  , ONLY : jp_idtra_2d     !: number of tracers in MEDUSA 
     24   USE par_idtra  , ONLY : jp_idtra_3d     !: number of tracers in MEDUSA 
     25   USE par_idtra  , ONLY : jp_idtra_trd    !: number of tracers in MEDUSA 
     26 
    1727   IMPLICIT NONE 
    1828 
    19    INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     !: cumulative number of passive tracers 
    20    INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  !: 
    21    INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  !: 
    22    INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd !: 
     29   INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     + jp_medusa     + & 
     30                      jp_idtra     !: cumulative number of passive tracers 
     31   INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  + jp_medusa_2d  + & 
     32                      jp_idtra_2d !: 
     33   INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  + jp_medusa_3d  + & 
     34                      jp_idtra_3d !: 
     35   INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd + jp_medusa_trd + & 
     36                      jp_idtra_trd !: 
    2337    
    2438#if defined key_cfc 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r6636 r6639  
    1515   !!   cfc_init     :  sets constants for CFC surface forcing computation 
    1616   !!---------------------------------------------------------------------- 
     17   USE dom_oce       ! ocean space and time domain 
    1718   USE oce_trc       ! Ocean variables 
    1819   USE par_trc       ! TOP parameters 
    … …  
    176177         !                                                  !----------------! 
    177178      END DO                                                !  end CFC loop  ! 
    178       ! 
    179       IF( lrst_trc ) THEN 
    180          IF(lwp) WRITE(numout,*) 
    181          IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   & 
    182             &                    'at it= ', kt,' date= ', ndastp 
    183          IF(lwp) WRITE(numout,*) '~~~~' 
    184          DO jn = jp_cfc0, jp_cfc1 
    185             CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
    186          END DO 
    187       ENDIF                                             
     179         ! 
     180      IF( kt == nittrc000 ) THEN 
     181         DO jl = 1, jp_cfc    
     182             WRITE(NUMOUT,*) ' ' 
     183             WRITE(NUMOUT,*) 'CFC interpolation verification '  !! Jpalm   
     184             WRITE(NUMOUT,*) '################################## ' 
     185             WRITE(NUMOUT,*) ' ' 
     186               if (jl.EQ.1) then 
     187                   WRITE(NUMOUT,*) 'Traceur = CFC11: ' 
     188               elseif (jl.EQ.2) then 
     189                   WRITE(NUMOUT,*) 'Traceur = CFC12: ' 
     190               endif 
     191             WRITE(NUMOUT,*) 'nyear    = ', nyear 
     192             WRITE(NUMOUT,*) 'nmonth   = ', nmonth 
     193             WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg 
     194             WRITE(NUMOUT,*) 'iyear_end= ', iyear_end 
     195             WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl) 
     196             WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl) 
     197             WRITE(NUMOUT,*) 'Im1= ',im1 
     198             WRITE(NUMOUT,*) 'Im2= ',im2 
     199             WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc 
     200             WRITE(NUMOUT,*) ' ' 
     201         END DO   
     202# if defined key_debug_medusa 
     203         CALL flush(numout) 
     204# endif 
     205      ENDIF 
     206        ! 
     207      !IF( lrst_trc ) THEN 
     208      !   IF(lwp) WRITE(numout,*) 
     209      !   IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   & 
     210      !      &                    'at it= ', kt,' date= ', ndastp 
     211      !   IF(lwp) WRITE(numout,*) '~~~~' 
     212      !   DO jn = jp_cfc0, jp_cfc1 
     213      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
     214      !   END DO 
     215      !ENDIF                                             
    188216      ! 
    189217      IF( lk_iomput ) THEN 
    … …  
    203231      END IF 
    204232      ! 
     233# if defined key_debug_medusa 
     234      IF(lwp) WRITE(numout,*) '   CFC - Check: nn_timing = ', nn_timing 
     235      CALL flush(numout) 
     236# endif 
    205237      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc') 
    206238      ! 
    … …  
    254286      sca(4,2) =  -0.067430 
    255287 
    256       IF( ln_rsttr ) THEN 
    257          IF(lwp) WRITE(numout,*) 
    258          IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model ' 
    259          IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    260          ! 
    261          DO jn = jp_cfc0, jp_cfc1 
    262             CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )  
    263          END DO 
    264       ENDIF 
     288      !IF( ln_rsttr ) THEN 
     289      !   IF(lwp) WRITE(numout,*) 
     290      !   IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model ' 
     291      !   IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     292      !   ! 
     293      !   DO jn = jp_cfc0, jp_cfc1 
     294      !      CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )  
     295      !   END DO 
     296      !ENDIF 
    265297      IF(lwp) WRITE(numout,*) 
    266298      ! 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/par_idtra.F90

    r5726 r6639  
    2121   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA 
    2222 
     23   IMPLICIT NONE 
    2324 
    24    IMPLICIT NONE 
    25    PUBLIC 
    26  
    27    INTEGER, PUBLIC, PARAMETER ::   jp_lp      =  jp_pisces     + jp_medusa     !: cumulative number of passive tracers 
    28    INTEGER, PUBLIC, PARAMETER ::   jp_lp_2d   =  jp_pisces_2d  + jp_medusa_2d  !: 
    29    INTEGER, PUBLIC, PARAMETER ::   jp_lp_3d   =  jp_pisces_3d  + jp_medusa_3d  !: 
    30    INTEGER, PUBLIC, PARAMETER ::   jp_lp_trd  =  jp_pisces_trd + jp_medusa_trd !: 
     25   INTEGER, PARAMETER ::   jp_lp      =  jp_pisces     +  jp_medusa     !: cumulative number of passive tracers 
     26   INTEGER, PARAMETER ::   jp_lp_2d   =  jp_pisces_2d  +  jp_medusa_2d  !: 
     27   INTEGER, PARAMETER ::   jp_lp_3d   =  jp_pisces_3d  +  jp_medusa_3d  !: 
     28   INTEGER, PARAMETER ::   jp_lp_trd  =  jp_pisces_trd +  jp_medusa_trd !: 
    3129 
    3230#if defined key_idtra 
    … …  
    3634   LOGICAL, PUBLIC, PARAMETER ::   lk_idtra     = .TRUE.      !: IDEAL-TRACER flag 
    3735   INTEGER, PUBLIC, PARAMETER ::   jp_idtra     =  1          !: number of passive tracers 
    38    INTEGER, PUBLIC, PARAMETER ::   jp_idtra_2d  =  0          !: additional 2d output arrays ('key_trc_diaadd') 
     36   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_2d  =  3          !: additional 2d output arrays ('key_trc_diaadd') 
    3937   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd') 
    4038   INTEGER, PUBLIC, PARAMETER ::   jp_idtra_trd =  0          !: number of sms trends for IDEAL-TRACER 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcini_idtra.F90

    r5726 r6639  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_idtra    ! IDEAL-TRACER sms trends 
    18    USE par_idtra       ! IDEAL-TRACER parameters 
    19    USE in_out_manager  ! I/O manager 
    20    USE lib_mpp 
    21    USE iom 
     18   ! USE par_idtra       ! IDEAL-TRACER parameters 
     19   ! USE in_out_manager  ! I/O manager 
     20   ! USE lib_mpp 
     21   ! USE iom 
    2222 
    2323   IMPLICIT NONE 
    … …  
    4646      !!---------------------------------------------------------------------- 
    4747 
     48      IF(lwp) WRITE(numout,*) 
     49      IF(lwp) WRITE(numout,*) ' trc_ini_idtra: initialisation of Ideal Tracers model' 
     50      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
     51 
     52      IF( trc_sms_idtra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_idtra:unable to allocate CFC arrays' ) 
     53 
    4854 
    4955      ! Initialization of trn in case of  no restart 
    5056      !---------------------------------------------- 
     57      qtr_idtra(:,:,:) = 0._wp 
     58      inv_idtra(:,:,:) = 0._wp 
    5159      IF( .NOT. ln_rsttr ) THEN 
    5260         IF(lwp) THEN 
    5361            WRITE(numout,*) 
    54             WRITE(numout,*) 'Initialization de id-tracers ; No restart : ' 
     62            WRITE(numout,*) 'Initialization of id-tracers ; No restart : ' 
    5563            WRITE(numout,*) '                             ; Init field equal 1 at surface - zero elsewhere' 
     64            WRITE(numout,*) '                             ; qint idtra equal 0 ' 
    5665         ENDIF 
     66         qint_idtra(:,:,:) = 0._wp 
    5767         DO jn = jp_idtra0, jp_idtra1 
    5868             trn(:,:,:,jn) = 0.e0 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcnam_idtra.F90

    r5726 r6639  
    1515   USE par_trc         ! TOP parameters 
    1616   USE trc             ! TOP variables 
    17    USE trcsms_idtra      ! IDEAL-TRACER specific variable 
    18    USE in_out_manager  ! I/O manager 
     17   USE trcsms_idtra    ! IDEAL-TRACER specific variable 
     18   USE iom             ! I/O manager 
    1919 
    2020   IMPLICIT NONE 
    … …  
    4242      !! ** input   :   Namelist namidtra 
    4343      !!---------------------------------------------------------------------- 
    44       REAL(wp) ::   tmp_decay          !! Years ; half time decay of our idealize tracer 
    45       REAL(wp) ::   TDECyr, TDEC    
    46       CHARACTER(LEN=32)   ::   clname 
    47       !!  
     44      INTEGER  :: numnatm_ref = -1   ! Logical unit for reference ID-TRA namelist 
     45      INTEGER  :: numnatm_cfg = -1   ! Logical unit for configuration ID-TRA namelist 
     46      INTEGER  :: numonc      = -1   ! Logical unit for output namelist 
     47      INTEGER  :: ios                 ! Local integer output status for namelist read 
     48      REAL(wp) :: tmp_decay          !! Years ; half time decay of our idealize tracer 
     49      REAL(wp) :: TDECyr, TDEC    
     50      !! ---------------------------------------------------------------- 
    4851      NAMELIST/namidtra/tmp_decay 
    49 !! #if defined key_trc_diaadd 
    50 !!      ! definition of additional diagnostic as a structure 
    51 !!      INTEGER :: jl, jn 
    52 !! 
    53 !! #endif 
    54       !! 
    55  
    56 !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    57 !! Jpalm -- 4-11-2014 
    58 !! namelist for idealize tracer 
    59 !! only thing in namelist is the chosen half time decay 
    60 !! no atmospheric conditions, cause we do impose a surface concentration of 1, 
    61 !! and no additionnal diagnostics,  
    62 !! because the only thing we are interested in is the water mass concentration on this tracer. 
    63 !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    64  
    65  
     52      !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     53      !! Jpalm -- 4-11-2014 
     54      !! namelist for idealize tracer 
     55      !! only thing in namelist is the chosen half time decay 
     56      !! no atmospheric conditions, cause we do impose a surface concentration of 1, 
     57      !! and no additionnal diagnostics,  
     58      !! because the only thing we are interested in is the water mass concentration on this tracer. 
     59      !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    6660      IF(lwp) WRITE(numout,*) 
    67       clname = 'namelist_idtra' 
    6861      IF(lwp) WRITE(numout,*) ' trc_nam_idtra: read IDEAL-TRACER namelist' 
    6962      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    … …  
    7164      !! Open the namelist file : 
    7265      !!~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    73       CALL ctl_opn( numnatm, TRIM( clname ), 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    74  
     66      CALL ctl_opn( numnatm_ref, 'namelist_idtra_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     67      CALL ctl_opn( numnatm_cfg, 'namelist_idtra_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     68      IF(lwm) CALL ctl_opn( numonc, 'output.namelist.idtra', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    7569      !! Read the namelists : 
    7670      !!~~~~~~~~~~~~~~~~~~~~~~~ 
    … …  
    7973      !! tmp_decay = 1y ; 10y ; 100y or 1000y depending of which water mass you want to track 
    8074      !!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    81       READ(numnatm,namidtra) 
     75 
     76      REWIND( numnatm_ref )              ! Namelist namidtra in reference namelist : IDTRA parameters 
     77      READ  ( numnatm_ref, namidtra, IOSTAT = ios, ERR = 901) 
     78901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namidtra in reference namelist', lwp ) 
     79 
     80      REWIND( numnatm_cfg )              ! Namelist namidtra in configuration namelist : IDTRA parameters 
     81      READ  ( numnatm_cfg, namidtra, IOSTAT = ios, ERR = 902 ) 
     82902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namidtra in configuration namelist', lwp ) 
     83      IF(lwm) WRITE ( numonc, namidtra ) 
    8284 
    8385      IF(lwp) WRITE(numout,*) '   -  half time decay of our idealize tracer : ', tmp_decay 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90

    r5726 r6639  
    1818   USE par_trc      ! TOP parameters 
    1919   USE trc          ! TOP variables 
    20    USE trdtrc_oce 
     20   USE trd_oce 
    2121   USE trdtrc 
    2222   USE iom 
    … …  
    2525   PRIVATE 
    2626 
    27    PUBLIC   trc_sms_idtra       ! called in ??? 
    28  
     27   PUBLIC   trc_sms_idtra        ! called in ??? 
     28   PUBLIC   trc_sms_idtra_alloc  ! called in ??? 
     29   ! 
    2930   INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year) 
    3031   INTEGER , PUBLIC    ::   numnatm 
    31  
    3232   REAL(wp), PUBLIC    ::   FDEC 
     33   ! 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_idtra  ! flux at surface 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_idtra ! cumulative flux  
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   inv_idtra  ! vertic. inventory 
     37 
    3338   !                          ! coefficients for conversion 
    3439   REAL(wp) ::  WTEMP 
    … …  
    6974      !!               
    7075      !!---------------------------------------------------------------------- 
    71       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    72       !! 
    73       INTEGER ::   ji, jj, jn, jl, jk 
    74  
    75  
    76  
    77       !!---------------------------------------------------------------------- 
    78       IF(lwp) WRITE(numout,*) '   - JPALM - verif :' 
    79       IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~' 
    80       IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC 
    81  
     76      INTEGER, INTENT( in )  ::   kt    ! ocean time-step index 
     77      !! 
     78      INTEGER                ::   ji, jj, jn, jl, jk 
     79      REAL(wp)               ::   rlx                 !! relaxation time (1 day) 
     80      !!---------------------------------------------------------------------- 
     81      ! 
     82      IF( nn_timing == 1 )  CALL timing_start('trc_sms_idtra') 
     83      ! 
     84      rlx = 10./(60. * 60. * 24.)                              !! relaxation time (1/10 day) 
     85      IF (kt == nittrc000) THEN 
     86         IF(lwp) WRITE(numout,*) '   trcsms_idtra :' 
     87         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~' 
     88         IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC 
     89         IF(lwp) WRITE(numout,*) '   - relaxation time    : ', rlx 
     90# if defined key_debug_medusa 
     91         CALL flush(numout) 
     92# endif 
     93      !   CALL idtra_init 
     94      ENDIF 
    8295 
    8396         ! 
    84 DO jn = jp_idtra0, jp_idtra1 
    85  
    86         ! DO jj = 1, jpj 
    87         !    DO ji = 1, jpi 
    88                ! Surface concentrarion fixed to 1 (ideal tracer concentration unit) 
    89                trn(:,:,1,jn) = 1. 
    90                trb(:,:,1,jn) = 1. 
    91                ! 
    92         !    ENDDO 
    93         ! ENDDO 
    94  
     97      inv_idtra(:,:,:) = 0.0                                   !! init the inventory 
     98      qtr_idtra(:,:,:) = 0.0                                   !! init the air-sea flux 
     99      DO jl = 1, jp_idtra 
     100         jn = jp_idtra0 + jl - 1 
     101 
     102      !!   DO jj = 1, jpj 
     103      !!      DO ji = 1, jpi 
     104           DO jj = 2,jpjm1 
     105              DO ji = 2,jpim1 
     106 
     107         !! First, a crude version. will be much inproved later. 
     108             qtr_idtra(ji,jj,jl)  = rlx * (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) *   &  
     109                                  fse3t(ji,jj,1)                  !! Air-sea Flux 
     110 
     111           !! DEBUG-TEST : Set flux equal to 0, see if it induces the pb we see in the MED   
     112           !!  qtr_idtra(ji,jj,jl)  = 0.0 
     113           ENDDO 
     114         ENDDO 
     115         tra(:,:,1,jn)      = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) *  & 
     116                            tmask(:,:,1) / fse3t(:,:,1) ) 
     117         qint_idtra(:,:,jl) = qint_idtra(:,:,jl) +                   &            
     118                              qtr_idtra(:,:,jl) * rdt              !! Cumulative Air-sea Flux 
     119 
     120 
     121         DO jk =1,jpk 
     122            inv_idtra(:,:,jl) = inv_idtra(:,:,jl) +                  & 
     123                     (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk))  !! vertical inventory 
     124         ENDDO 
    95125! 
    96126!DECAY of OUR IDEALIZED TRACER 
    … …  
    98128 
    99129         DO  jk =1,jpk 
    100             DO jj=1,jpj 
    101               DO  ji =1,jpi 
     130      !!      DO jj=1,jpj 
     131      !!        DO  ji =1,jpi 
     132            DO jj = 2,jpjm1 
     133               DO ji = 2,jpim1 
     134             
    102135               !  IF (trn(ji,jj,jk,jn) > 0.0) THEN 
    103136                    WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC ) 
    104                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - WTEMP/rdt 
     137                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * & 
     138                                     tmask(ji,jj,jk) 
    105139               !  ENDIF  
    106140              ENDDO  
    … …  
    108142         ENDDO 
    109143 
    110 ENDDO 
     144      ENDDO 
    111145    !! jn loop 
    112146! 
    113  
    114 !!!!!! No added diagnostics to save here for idealize tracers... 
    115 !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    116 !! #if defined key_trc_diaadd 
    117 !!       ! Save diagnostics , just for TRI111 
    118 !! # if ! defined key_iomput 
    119 !!       trc2d(:,:,jp_idtra0_2d    ) = zpp_idtra(:,:) 
    120 !! # else 
    121 !! !           WRITE(NUMOUT,*) 'Iomput idtrasurf ' 
    122 !!       CALL iom_put( "TRISURF"  , zpp_idtra(:,:) ) 
    123 !! !      CALL iom_put( "TRISURF"  , xphem(:,:) ) 
    124 !! !           WRITE(NUMOUT,*) 'Iomputage ' 
    125 !!        CALL iom_put( "AGE"  , zage(:,:,:) ) 
    126 !! # endif 
    127 !! #endif 
    128 !! 
    129  
    130 !!      IF( l_trdtrc ) THEN 
    131 !!          DO jn = jp_idtra0, jp_idtra1 
    132 !!            zidtradtra(:,:,:) = tra(:,:,:,jn) 
    133 !!            CALL trd_mod_trc( zidtradtra, jn, jptrc_trd_sms, kt )   ! save trends 
    134 !!          END DO 
    135 !!      END IF 
    136  
     147# if defined key_debug_medusa 
     148         IF(lwp) WRITE(numout,*) '   IDTRA - calculation part - DONE trc_sms_idtra -- ' 
     149      CALL flush(numout) 
     150# endif 
     151        ! 
     152        !! restart and diagnostics management --  
     153      !IF( lrst_trc ) THEN 
     154      !   IF(lwp) WRITE(numout,*) 
     155      !   IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ',   & 
     156      !      &                    'at it= ', kt,' date= ', ndastp 
     157      !   IF(lwp) WRITE(numout,*) '~~~~' 
     158      !   !!DO jn = jp_idtra0, jp_idtra1 
     159      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) ) 
     160      !   !!END DO 
     161 ! if defined key_debug_medusa 
     162      !   IF(lwp) WRITE(numout,*) '   IDTRA - writing diag-restart - DONE trc_sms_idtra -- ' 
     163      !   CALL flush(numout) 
     164 ! endif 
     165      !ENDIF 
     166      ! 
     167      IF( lk_iomput ) THEN 
     168         CALL iom_put( "qtrIDTRA"  , qtr_idtra (:,:,1) ) 
     169         CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) ) 
     170         CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) ) 
     171      ELSE 
     172         IF( ln_diatrc ) THEN 
     173            trc2d(:,:,jp_idtra0_2d    ) = qtr_idtra (:,:,1) 
     174            trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1) 
     175            trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1) 
     176         END IF 
     177      END IF 
     178      ! 
     179# if defined key_debug_medusa 
     180      IF(lwp) WRITE(numout,*) '   IDTRA - writing diag - DONE trc_sms_idtra -- ' 
     181      CALL flush(numout) 
     182# endif 
     183      ! 
     184      IF( l_trdtrc ) THEN 
     185# if defined key_debug_medusa 
     186         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - trc_sms_idtra -- ' 
     187         CALL flush(numout) 
     188# endif 
     189          DO jn = jp_idtra0, jp_idtra1 
     190            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     191          END DO 
     192# if defined key_debug_medusa 
     193         IF(lwp) WRITE(numout,*) '   IDTRA - writing trends - DONE trc_sms_idtra -- ' 
     194         CALL flush(numout) 
     195# endif 
     196      END IF 
     197      ! 
     198# if defined key_debug_medusa 
     199         IF(lwp) WRITE(numout,*) '   IDTRA - Check: nn_timing = ', nn_timing  
     200         CALL flush(numout) 
     201# endif 
     202      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_idtra') 
     203      ! 
     204# if defined key_debug_medusa 
     205         IF(lwp) WRITE(numout,*) '   IDTRA DONE trc_sms_idtra -- ' 
     206      CALL flush(numout) 
     207# endif 
     208      ! 
    137209   END SUBROUTINE trc_sms_idtra 
     210 
     211   SUBROUTINE idtra_init 
     212      !!--------------------------------------------------------------------- 
     213      !!                     ***  idtra_init  *** 
     214      !! 
     215      !! ** Purpose : read restart values for IDTRA model 
     216      !!--------------------------------------------------------------------- 
     217      INTEGER :: jn 
     218 
     219      IF( ln_rsttr ) THEN 
     220         IF(lwp) WRITE(numout,*) 
     221         IF(lwp) WRITE(numout,*) ' Read specific variables from Ideal Tracers model ' 
     222         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     223         ! 
     224         DO jn = jp_idtra0, jp_idtra1 
     225            CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,jn) ) 
     226         END DO 
     227      ENDIF 
     228      IF(lwp) WRITE(numout,*) 'idtra restart variables read -- OK' 
     229      ! 
     230   END SUBROUTINE idtra_init 
     231 
     232   INTEGER FUNCTION trc_sms_idtra_alloc() 
     233      !!---------------------------------------------------------------------- 
     234      !!                     ***  ROUTINE trc_sms_idtra_alloc  *** 
     235      !!---------------------------------------------------------------------- 
     236      ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) ,     & 
     237         &      inv_idtra(jpi,jpj,jp_idtra)  ,     & 
     238         &      qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc ) 
     239         ! 
     240      IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.') 
     241      ! 
     242   END FUNCTION trc_sms_idtra_alloc 
     243 
    138244#else 
    139245   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcwri_idtra.F90

    r5726 r6639  
    1313   !! trc_wri_idtra   :  outputs of concentration fields 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce_trc         ! Ocean variables 
    16    USE par_trc         ! TOP parameters 
     15   ! USE oce_trc         ! Ocean variables 
     16   ! USE par_trc         ! TOP parameters 
    1717   USE trc             ! passive tracers common variables 
    18    USE trcsms_idtra    ! IDEALIZE TRACER sms trends 
     18   ! USE trcsms_idtra    ! IDEALIZE TRACER sms trends 
    1919   USE iom             ! I/O manager 
    2020 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/par_medusa.F90

    r5726 r6639  
    1515   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1616   !!---------------------------------------------------------------------- 
     17   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES 
     18   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES 
     19   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES 
     20   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    1721 
    1822   IMPLICIT NONE 
     23 
     24   INTEGER, PARAMETER ::   jp_lm      =  jp_pisces      !:  
     25   INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d   !: 
     26   INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d   !: 
     27   INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd  !: 
    1928 
    2029#if defined key_medusa 
    … …  
    3645 
    3746   ! assign an index in trc arrays for each PTS prognostic variables 
    38    INTEGER, PUBLIC, PARAMETER ::   jpchn  =  1              !: non-diatom chlorophyll concentration 
    39    INTEGER, PUBLIC, PARAMETER ::   jpchd  =  2              !: diatom     chlorophyll concentration 
    40    INTEGER, PUBLIC, PARAMETER ::   jpphn  =  3              !: non-diatom concentration 
    41    INTEGER, PUBLIC, PARAMETER ::   jpphd  =  4              !: diatom     concentration 
    42    INTEGER, PUBLIC, PARAMETER ::   jpzmi  =  5              !: microzooplankton concentration 
    43    INTEGER, PUBLIC, PARAMETER ::   jpzme  =  6              !: mesozooplankton  concentration 
    44    INTEGER, PUBLIC, PARAMETER ::   jpdin  =  7              !: dissolved inorganic nitrogen concentration 
    45    INTEGER, PUBLIC, PARAMETER ::   jpsil  =  8              !: silicic acid concentration 
    46    INTEGER, PUBLIC, PARAMETER ::   jpfer  =  9              !: total iron concentration 
    47    INTEGER, PUBLIC, PARAMETER ::   jpdet  = 10              !: slow-sinking detritus concentration 
    48    INTEGER, PUBLIC, PARAMETER ::   jppds  = 11              !: diatom silicon concentration 
     47   INTEGER, PUBLIC, PARAMETER ::   jpchn  =  jp_lm + 1      !: non-diatom chlorophyll concentration 
     48   INTEGER, PUBLIC, PARAMETER ::   jpchd  =  jp_lm + 2      !: diatom     chlorophyll concentration 
     49   INTEGER, PUBLIC, PARAMETER ::   jpphn  =  jp_lm + 3      !: non-diatom concentration 
     50   INTEGER, PUBLIC, PARAMETER ::   jpphd  =  jp_lm + 4      !: diatom     concentration 
     51   INTEGER, PUBLIC, PARAMETER ::   jpzmi  =  jp_lm + 5      !: microzooplankton concentration 
     52   INTEGER, PUBLIC, PARAMETER ::   jpzme  =  jp_lm + 6      !: mesozooplankton  concentration 
     53   INTEGER, PUBLIC, PARAMETER ::   jpdin  =  jp_lm + 7      !: dissolved inorganic nitrogen concentration 
     54   INTEGER, PUBLIC, PARAMETER ::   jpsil  =  jp_lm + 8      !: silicic acid concentration 
     55   INTEGER, PUBLIC, PARAMETER ::   jpfer  =  jp_lm + 9      !: total iron concentration 
     56   INTEGER, PUBLIC, PARAMETER ::   jpdet  =  jp_lm + 10     !: slow-sinking detritus concentration 
     57   INTEGER, PUBLIC, PARAMETER ::   jppds  =  jp_lm + 11     !: diatom silicon concentration 
    4958# if defined key_roam 
    50    INTEGER, PUBLIC, PARAMETER ::   jpdtc  = 12              !: slow-sinking detritus carbon concentration 
    51    INTEGER, PUBLIC, PARAMETER ::   jpdic  = 13              !: dissolved inorganic carbon concentration 
    52    INTEGER, PUBLIC, PARAMETER ::   jpalk  = 14              !: alkalinity 
    53    INTEGER, PUBLIC, PARAMETER ::   jpoxy  = 15              !: dissolved oxygen concentration 
     59   INTEGER, PUBLIC, PARAMETER ::   jpdtc  =  jp_lm + 12     !: slow-sinking detritus carbon concentration 
     60   INTEGER, PUBLIC, PARAMETER ::   jpdic  =  jp_lm + 13     !: dissolved inorganic carbon concentration 
     61   INTEGER, PUBLIC, PARAMETER ::   jpalk  =  jp_lm + 14     !: alkalinity 
     62   INTEGER, PUBLIC, PARAMETER ::   jpoxy  =  jp_lm + 15     !: dissolved oxygen concentration 
    5463# endif 
    5564 
    … …  
    6675 
    6776   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 
    68    INTEGER, PUBLIC, PARAMETER ::   jp_msa0     = 1              !: First index of MEDUSA passive tracers 
    69    INTEGER, PUBLIC, PARAMETER ::   jp_msa1     = jp_medusa      !: Last  index of MEDUSA passive tracers 
    70    INTEGER, PUBLIC, PARAMETER ::   jp_msa0_2d  = 1              !: First index of MEDUSA passive tracers 
    71    INTEGER, PUBLIC, PARAMETER ::   jp_msa1_2d  = jp_medusa_2d   !: Last  index of MEDUSA passive tracers 
    72    INTEGER, PUBLIC, PARAMETER ::   jp_msa0_3d  = 1              !: First index of MEDUSA passive tracers 
    73    INTEGER, PUBLIC, PARAMETER ::   jp_msa1_3d  = jp_medusa_3d   !: Last  index of MEDUSA passive tracers 
    74    INTEGER, PUBLIC, PARAMETER ::   jp_msa0_trd = 1              !: First index of MEDUSA passive tracers 
    75    INTEGER, PUBLIC, PARAMETER ::   jp_msa1_trd = jp_medusa_trd  !: Last  index of MEDUSA passive tracers 
     77   INTEGER, PUBLIC, PARAMETER ::   jp_msa0     = jp_lm     + 1              !: First index of MEDUSA passive tracers 
     78   INTEGER, PUBLIC, PARAMETER ::   jp_msa1     = jp_lm     + jp_medusa      !: Last  index of MEDUSA passive tracers 
     79   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_2d  = jp_lm_2d  + 1              !: First index of MEDUSA passive tracers 
     80   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_2d  = jp_lm_2d  + jp_medusa_2d   !: Last  index of MEDUSA passive tracers 
     81   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_3d  = jp_lm_3d  + 1              !: First index of MEDUSA passive tracers 
     82   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_3d  = jp_lm_3d  + jp_medusa_3d   !: Last  index of MEDUSA passive tracers 
     83   INTEGER, PUBLIC, PARAMETER ::   jp_msa0_trd = jp_lm_trd + 1              !: First index of MEDUSA passive tracers 
     84   INTEGER, PUBLIC, PARAMETER ::   jp_msa1_trd = jp_lm_trd + jp_medusa_trd  !: Last  index of MEDUSA passive tracers 
    7685 
    7786   !!====================================================================== 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90

    r5726 r6639  
    172172!! 
    173173!! UKESM diagnostics 
    174    INTEGER  ::  jdms      !:  include DMS diagnostics ? Jpalm (27-08-2014)  
     174   INTEGER  ::  jdms         !: include DMS diagnostics ? Jpalm (27-08-2014)  
     175   INTEGER  ::  jdms_input   !: use instant (0) or diel-average (1) inputs (AXY, 08/07/2015) 
     176   INTEGER  ::  jdms_model   !: choice of DMS model passed to atmosphere 
     177!!                              1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL 
    175178!! 
    176179!! 
    … …  
    217220   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_sed_ca   !: 2D inorganic carbon   (now) 
    218221   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_sed_ca   !: 2D inorganic carbon   (after) 
     222!! 
     223!! 2D fields of temporally averaged properties for DMS calculations (AXY, 07/07/15) 
     224   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_chn  !: 2D avg CHN   (before) 
     225   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_chn  !: 2D avg CHN   (now) 
     226   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_chn  !: 2D avg CHN   (after) 
     227   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_chd  !: 2D avg CHD   (before) 
     228   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_chd  !: 2D avg CHD   (now) 
     229   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_chd  !: 2D avg CHD   (after) 
     230   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_mld  !: 2D avg MLD   (before) 
     231   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_mld  !: 2D avg MLD   (now) 
     232   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_mld  !: 2D avg MLD   (after) 
     233   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_qsr  !: 2D avg QSR   (before) 
     234   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_qsr  !: 2D avg QSR   (now) 
     235   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_qsr  !: 2D avg QSR   (after) 
     236   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_dms_din  !: 2D avg DIN   (before) 
     237   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zn_dms_din  !: 2D avg DIN   (now) 
     238   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: za_dms_din  !: 2D avg DIN   (after) 
    219239#endif 
    220240 
    … …  
    230250!! 
    231251   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust      !: dust parameter 1 
    232    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dustmo    !: dust parameter 2 
    233252 
    234253!!---------------------------------------------------------------------- 
    … …  
    415434      !!---------------------------------------------------------------------- 
    416435      USE lib_mpp , ONLY: ctl_warn 
    417       INTEGER ::   ierr(6)        ! Local variables 
     436      INTEGER ::   ierr(7)        ! Local variables 
    418437      !!---------------------------------------------------------------------- 
    419438      ierr(:) = 0 
    … …  
    439458         &      zb_sed_ca(jpi,jpj)   , zn_sed_ca(jpi,jpj)   ,       & 
    440459         &      za_sed_ca(jpi,jpj)   ,                           STAT=ierr(3) ) 
     460      !* 2D fields of temporally averaged properties for DMS calculations (AXY, 07/07/15) 
     461      ALLOCATE( zb_dms_chn(jpi,jpj)  , zn_dms_chn(jpi,jpj)  ,       & 
     462         &      za_dms_chn(jpi,jpj)  ,                              & 
     463         &      zb_dms_chd(jpi,jpj)  , zn_dms_chd(jpi,jpj)  ,       &         
     464         &      za_dms_chd(jpi,jpj)  ,                              & 
     465         &      zb_dms_mld(jpi,jpj)  , zn_dms_mld(jpi,jpj)  ,       &         
     466         &      za_dms_mld(jpi,jpj)  ,                              & 
     467         &      zb_dms_qsr(jpi,jpj)  , zn_dms_qsr(jpi,jpj)  ,       &         
     468         &      za_dms_qsr(jpi,jpj)  ,                              & 
     469         &      zb_dms_din(jpi,jpj)  , zn_dms_din(jpi,jpj)  ,       &         
     470         &      za_dms_din(jpi,jpj)  ,                           STAT=ierr(4) ) 
    441471# endif 
    442472      !* 2D fields of miscellaneous parameters 
    443473      ALLOCATE( ocal_ccd(jpi,jpj)    , dust(jpi,jpj)        ,       & 
    444          &      dustmo(jpi,jpj,2)    , riv_n(jpi,jpj)       ,       & 
     474         &      riv_n(jpi,jpj)                              ,       & 
    445475         &      riv_si(jpi,jpj)      , riv_c(jpi,jpj)       ,       & 
    446          &      riv_alk(jpi,jpj)     , friver_dep(jpk,jpk)  ,    STAT=ierr(4) ) 
     476         &      riv_alk(jpi,jpj)     , friver_dep(jpk,jpk)  ,    STAT=ierr(5) ) 
    447477      !* 2D and 3D fields of light parameters 
    448478      ALLOCATE( neln(jpi,jpj)        , xze(jpi,jpj)         ,       & 
    449          &      xpar(jpi,jpj,jpk)    ,                           STAT=ierr(5) ) 
     479         &      xpar(jpi,jpj,jpk)    ,                           STAT=ierr(6) ) 
    450480      !* 2D and 3D fields of sediment-associated parameters 
    451481      ALLOCATE( dminl(jpi,jpj)       , dmin3(jpi,jpj,jpk)   ,       & 
    … …  
    454484         &      fbodf(jpi,jpj)       , fbods(jpi,jpj)       ,       & 
    455485         &      ffln(jpi,jpj,jpk)    , fflf(jpi,jpj,jpk)    ,       & 
    456          &      ffls(jpi,jpj,jpk)    , cmask(jpi,jpj)       ,    STAT=ierr(6) )  
     486         &      ffls(jpi,jpj,jpk)    , cmask(jpi,jpj)       ,    STAT=ierr(7) )  
    457487#endif 
    458488      ! 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r5726 r6639  
    1616   !!  -   !  2013-05  (A. Yool)              updated for v3.5 
    1717   !!  -   !  2014-08  (A. Yool, J. Palm)     Add DMS module for UKESM1 model 
     18   !!  -   !  2015-06  (A. Yool)              Update to include MOCSY 
     19   !!  -   !  2015-07  (A. Yool)              Update for rolling averages 
     20   !!  -   !  2015-10  (J. Palm)              Update for diag outputs through iom_use   
    1821   !!---------------------------------------------------------------------- 
    1922   !! 
    … …  
    3639#endif 
    3740   !! 
     41#if defined key_mocsy 
     42   !!---------------------------------------------------------------------- 
     43   !! Updates with the addition of MOCSY include: 
     44   !!   - option to use PML or MOCSY carbonate chemistry (the latter is  
     45   !!     preferred) 
     46   !!   - central calculation of gas transfer velocity, f_kw660; previously 
     47   !!     this was done separately for CO2 and O2 with predictable results 
     48   !!   - distribution of f_kw660 to both PML and MOCSY CO2 air-sea flux  
     49   !!     calculations and to those for O2 air-sea flux 
     50   !!   - extra diagnostics included for MOCSY 
     51   !!---------------------------------------------------------------------- 
     52#endif 
     53   !! 
    3854#if defined key_medusa 
    3955   !!---------------------------------------------------------------------- 
    … …  
    5369# if defined key_iomput 
    5470      USE iom 
     71      USE trcnam_medusa         ! JPALM 13-11-2015 -- if iom_use for diag 
     72      !!USE trc_nam_iom_medusa  ! JPALM 13-11-2015 -- if iom_use for diag 
    5573# endif 
    5674# if defined key_roam 
     75      USE gastransfer 
     76#  if defined key_mocsy 
     77      USE mocsy_wrapper 
     78#  else 
    5779      USE trcco2_medusa 
     80#  endif 
    5881      USE trcoxy_medusa 
    5982      !! Jpalm (08/08/2014) 
    … …  
    134157      REAL(wp) ::    ztmp, zsal 
    135158# endif 
     159# if defined key_mocsy 
     160      REAL(wp) ::    zpho 
     161# endif 
    136162      !! 
    137163      !! integrated source and sink terms 
    … …  
    142168      !! 
    143169      !! primary production and chl related quantities       
    144       REAL(wp) ::    fthetan,faln,fchn1,fchn,fjln,fprn,frn 
    145       REAL(wp) ::    fthetad,fald,fchd1,fchd,fjld,fprd,frd 
     170      REAL(wp)                     ::    fthetan,faln,fchn1,fchn,fjln,fprn,frn 
     171      REAL(wp)                     ::    fthetad,fald,fchd1,fchd,fjld,fprd,frd 
    146172      !! AXY (03/02/11): add in Liebig terms 
    147173      REAL(wp) ::    fpnlim, fpdlim 
    … …  
    150176      INTEGER  ::    ieppley 
    151177      !! AXY (01/03/10): add in mixed layer PP diagnostics 
    152       REAL(wp) ::    fprn_ml,fprd_ml 
     178      REAL(wp), DIMENSION(jpi,jpj) ::  fprn_ml,fprd_ml 
    153179      !! 
    154180      !! nutrient limiting factors 
    … …  
    161187      !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme 
    162188      REAL(wp) ::    ffetop,ffebot,ffescav 
    163       REAL(wp) ::    xLgF, xFeT, xFeF, xFeL, xFree  !! state variables for iron-ligand system 
     189      REAL(wp) ::    xLgF, xFeT, xFeF, xFeL         !! state variables for iron-ligand system 
     190      REAL(wp), DIMENSION(jpi,jpj) ::  xFree        !! state variables for iron-ligand system 
    164191      REAL(wp) ::    xb_coef_tmp, xb2M4ac           !! iron-ligand parameters 
    165192      REAL(wp) ::    xmaxFeF,fdeltaFe               !! max Fe' parameters 
    … …  
    189216# endif 
    190217      REAL(wp) ::    fdpn2,fdpd2,fdpds2,fdzmi2,fdzme2 
    191       REAL(wp) ::    fslown, fslownflux 
    192       REAL(wp) ::    fslowc, fslowcflux 
     218      REAL(wp) ::    fslown, fslowc 
     219      REAL(wp), DIMENSION(jpi,jpj) ::    fslownflux, fslowcflux 
    193220      REAL(wp) ::    fregen,fregensi 
    194221      REAL(wp), DIMENSION(jpi,jpj) ::    fregenfast,fregenfastsi 
    … …  
    206233      REAL(wp) ::    fheren,fheresi,fherefe,fherec,fhereca 
    207234      REAL(wp) ::    fprotf 
    208       REAL(wp) ::    fsedn,fsedsi,fsedfe,fsedc,fsedca 
     235      REAL(wp), DIMENSION(jpi,jpj) ::    fsedn,fsedsi,fsedfe,fsedc,fsedca 
    209236      REAL(wp), DIMENSION(jpi,jpj) ::    fccd 
    210237      REAL(wp) ::    fccd_dep 
    … …  
    226253      !! 
    227254      !! water column nutrient and flux integrals 
    228       REAL(wp) ::    ftot_n,ftot_si,ftot_fe 
     255      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_n,ftot_si,ftot_fe 
    229256      REAL(wp), DIMENSION(jpi,jpj) ::    fflx_n,fflx_si,fflx_fe 
    230257      REAL(wp), DIMENSION(jpi,jpj) ::    fifd_n,fifd_si,fifd_fe 
    231258      REAL(wp), DIMENSION(jpi,jpj) ::    fofd_n,fofd_si,fofd_fe 
    232259# if defined key_roam 
    233       REAL(wp) ::    ftot_c,ftot_a,ftot_o2 
     260      REAL(wp), DIMENSION(jpi,jpj) ::    ftot_c,ftot_a,ftot_o2 
    234261      REAL(wp), DIMENSION(jpi,jpj) ::    fflx_c,fflx_a,fflx_o2 
    235262      REAL(wp), DIMENSION(jpi,jpj) ::    fifd_c,fifd_a,fifd_o2 
    … …  
    266293      REAL(wp) ::    f_kw660, f_o2flux, f_o2sat 
    267294      REAL(wp), DIMENSION(jpi,jpj) ::    f_omcal, f_omarg 
     295      !! 
     296      !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 
     297      REAL(wp) ::    f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm 
     298      REAL(wp) ::    f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2 
     299      !! 
    268300      INTEGER  ::    iters 
    269301      REAL(wp) ::    f_year 
    … …  
    273305      !! carbon, alkalinity production and consumption 
    274306      REAL(wp) ::    fc_prod, fc_cons, fa_prod, fa_cons 
    275       REAL(wp) ::    fcomm_resp 
     307      REAL(wp), DIMENSION(jpi,jpj) ::    fcomm_resp 
    276308      REAL(wp), DIMENSION(jpi,jpj) ::    fcar_prod, fcar_cons 
    277309      !! 
    … …  
    303335      !! horizontal grid location 
    304336      REAL(wp) ::    flatx, flonx 
    305  
     337      !! 
     338      !! Jpalm -- 11-10-2015 -- adapt diag to iom_use 
     339      !! 2D var for diagnostics. 
     340      REAL(wp), POINTER, DIMENSION(:,:  ) :: fprn2d, fdpn2d, fprd2d, fdpd2d, fprds2d, fsdiss2d, fgmipn2d 
     341      REAL(wp), POINTER, DIMENSION(:,:  ) :: fgmid2d, fdzmi2d, fgmepn2d, fgmepd2d, fgmezmi2d, fgmed2d 
     342      REAL(wp), POINTER, DIMENSION(:,:  ) :: fdzme2d, fslown2d, fdd2d, ffetop2d, ffebot2d, ffescav2d 
     343      REAL(wp), POINTER, DIMENSION(:,:  ) :: fjln2d, fnln2d, ffln2d, fjld2d, fnld2d, ffld2d, fsld2d2 
     344      REAL(wp), POINTER, DIMENSION(:,:  ) :: fsld2d, fregen2d, fregensi2d, ftempn2d, ftempsi2d, ftempfe2d 
     345      REAL(wp), POINTER, DIMENSION(:,:  ) :: ftempc2d, ftempca2d, freminn2d, freminsi2d, freminfe2d 
     346      REAL(wp), POINTER, DIMENSION(:,:  ) :: freminc2d, freminca2d 
     347      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
     348# if defined key_roam 
     349      REAL(wp), POINTER, DIMENSION(:,:  ) :: ffastca2d, rivn2d, rivsi2d, rivc2d, rivalk2d, fslowc2d 
     350      REAL(wp), POINTER, DIMENSION(:,:  ) :: fdpn22d, fdpd22d, fdzmi22d, fdzme22d, zimesn2d, zimesd2d 
     351      REAL(wp), POINTER, DIMENSION(:,:  ) :: zimesc2d, zimesdc2d, ziexcr2d, ziresp2d, zigrow2d, zemesn2d 
     352      REAL(wp), POINTER, DIMENSION(:,:  ) :: zemesd2d, zemesc2d, zemesdc2d, zeexcr2d, zeresp2d, zegrow2d 
     353      REAL(wp), POINTER, DIMENSION(:,:  ) :: mdetc2d, gmidc2d, gmedc2d, f_pco2a2d, f_pco2w2d, f_co2flux2d 
     354      REAL(wp), POINTER, DIMENSION(:,:  ) :: f_TDIC2d, f_TALK2d, f_kw6602d, f_pp02d, f_o2flux2d, f_o2sat2d 
     355      REAL(wp), POINTER, DIMENSION(:,:  ) :: dms_surf2d, dms_andr2d, dms_simo2d, dms_aran2d, dms_hall2d 
     356      REAL(wp), POINTER, DIMENSION(:,:  ) :: iben_n2d, iben_fe2d, iben_c2d, iben_si2d, iben_ca2d, oben_n2d 
     357      REAL(wp), POINTER, DIMENSION(:,:  ) :: oben_fe2d, oben_c2d, oben_si2d, oben_ca2d, sfr_ocal2d 
     358      REAL(wp), POINTER, DIMENSION(:,:  ) :: sfr_oarg2d, lyso_ca2d  
     359# endif 
     360      !! 2D var for diagnostics. 
     361      REAL(wp), POINTER, DIMENSION(:,:,:) :: tpp3d, detflux3d, remin3dn 
    306362      !!--------------------------------------------------------------------- 
     363 
     364# if defined key_debug_medusa 
     365      IF (lwp) write (numout,*) 'trc_bio_medusa: variables defined' 
     366      CALL flush(numout) 
     367# endif  
    307368 
    308369      !! AXY (20/11/14): alter this to report on first MEDUSA call 
    … …  
    376437      ffastc(:,:)  = 0.0        !! organic carbon 
    377438      ffastca(:,:) = 0.0        !! biogenic calcium carbonate 
     439      !! 
     440      fsedn(:,:)   = 0.0        !! Seafloor flux of N  
     441      fsedsi(:,:)  = 0.0        !! Seafloor flux of Si 
     442      fsedfe(:,:)  = 0.0        !! Seafloor flux of Fe 
     443      fsedc(:,:)   = 0.0        !! Seafloor flux of C 
     444      fsedca(:,:)  = 0.0        !! Seafloor flux of CaCO3 
    378445      !! 
    379446      fregenfast(:,:)   = 0.0   !! integrated  N regeneration (fast detritus) 
    … …  
    402469      fflx_a(:,:)  = 0.0        !! alkalinity flux total 
    403470      fflx_o2(:,:) = 0.0        !! oxygen     flux total 
     471      ftot_c(:,:)  = 0.0        !! carbon     inventory 
     472      ftot_a(:,:)  = 0.0        !! alkalinity inventory 
     473      ftot_o2(:,:) = 0.0        !! oxygen     inventory 
    404474      fifd_c(:,:)  = 0.0        !! carbon     fast detritus production 
    405475      fifd_a(:,:)  = 0.0        !! alkalinity fast detritus production 
    … …  
    420490      foxy_anox(:,:) = 0.0      !! unrealised oxygen consumption 
    421491# endif 
     492      ftot_n(:,:)   = 0.0       !! N inventory  
     493      ftot_si(:,:)  = 0.0       !! Si inventory 
     494      ftot_fe(:,:)  = 0.0       !! Fe inventory 
    422495      ftot_pn(:,:)  = 0.0       !! integrated non-diatom phytoplankton 
    423496      ftot_pd(:,:)  = 0.0       !! integrated diatom     phytoplankton 
    … …  
    454527      f_riv_c(:,:)   = 0.0      !! riverine C   input  
    455528      f_riv_alk(:,:) = 0.0      !! riverine alk input  
    456  
     529      !! 
     530      !! allocate and initiate 2D diag 
     531      !! ----------------------------- 
     532      !! Juju :: add kt condition !! 
     533      IF( lk_iomput .AND. .NOT.  ln_diatrc ) THEN  
     534      !! 
     535      if ( kt == nittrc000 )   CALL trc_nam_iom_medusa !! initialise iom_use test 
     536      !! 
     537      CALL wrk_alloc( jpi, jpj,      zw2d ) 
     538      zw2d(:,:)      = 0.0      !! 
     539      IF ( med_diag%PRN%dgsave ) THEN 
     540         CALL wrk_alloc( jpi, jpj,   fprn2d    ) 
     541         fprn2d(:,:)      = 0.0      !! 
     542      ENDIF 
     543      IF ( med_diag%MPN%dgsave ) THEN 
     544         CALL wrk_alloc( jpi, jpj,   fdpn2d    ) 
     545         fdpn2d(:,:)      = 0.0      !! 
     546      ENDIF 
     547      IF ( med_diag%PRD%dgsave ) THEN 
     548         CALL wrk_alloc( jpi, jpj,   fprd2d    ) 
     549         fprd2d(:,:)      = 0.0      !! 
     550      ENDIF 
     551      IF( med_diag%MPD%dgsave ) THEN 
     552         CALL wrk_alloc( jpi, jpj,   fdpd2d    ) 
     553         fdpd2d(:,:)      = 0.0      !! 
     554      ENDIF 
     555      IF( med_diag%OPAL%dgsave ) THEN 
     556         CALL wrk_alloc( jpi, jpj,   fprds2d    ) 
     557         fprds2d(:,:)      = 0.0      !! 
     558      ENDIF 
     559      IF( med_diag%OPALDISS%dgsave ) THEN 
     560         CALL wrk_alloc( jpi, jpj,   fsdiss2d    ) 
     561         fsdiss2d(:,:)      = 0.0      !! 
     562      ENDIF 
     563      IF( med_diag%GMIPn%dgsave ) THEN 
     564         CALL wrk_alloc( jpi, jpj,   fgmipn2d    ) 
     565         fgmipn2d(:,:)      = 0.0      !! 
     566      ENDIF 
     567      IF( med_diag%GMID%dgsave ) THEN 
     568         CALL wrk_alloc( jpi, jpj,   fgmid2d    ) 
     569         fgmid2d(:,:)      = 0.0      !! 
     570      ENDIF 
     571      IF( med_diag%MZMI%dgsave ) THEN 
     572         CALL wrk_alloc( jpi, jpj,   fdzmi2d    ) 
     573         fdzmi2d(:,:)      = 0.0      !! 
     574      ENDIF 
     575      IF( med_diag%GMEPN%dgsave ) THEN 
     576         CALL wrk_alloc( jpi, jpj,   fgmepn2d    ) 
     577         fgmepn2d(:,:)      = 0.0      !! 
     578      ENDIF 
     579      IF( med_diag%GMEPD%dgsave ) THEN 
     580         CALL wrk_alloc( jpi, jpj,   fgmepd2d    ) 
     581         fgmepd2d(:,:)      = 0.0      !! 
     582      ENDIF 
     583      IF( med_diag%GMEZMI%dgsave ) THEN 
     584         CALL wrk_alloc( jpi, jpj,   fgmezmi2d    ) 
     585         fgmezmi2d(:,:)      = 0.0      !! 
     586      ENDIF 
     587      IF( med_diag%GMED%dgsave ) THEN 
     588         CALL wrk_alloc( jpi, jpj,   fgmed2d    ) 
     589         fgmed2d(:,:)      = 0.0      !! 
     590      ENDIF 
     591      IF( med_diag%MZME%dgsave ) THEN 
     592         CALL wrk_alloc( jpi, jpj,   fdzme2d    ) 
     593         fdzme2d(:,:)      = 0.0      !! 
     594      ENDIF 
     595      IF( med_diag%DETN%dgsave ) THEN 
     596         CALL wrk_alloc( jpi, jpj,   fslown2d    ) 
     597         fslown2d(:,:)      = 0.0      !! 
     598      ENDIF 
     599      IF( med_diag%MDET%dgsave ) THEN 
     600         CALL wrk_alloc( jpi, jpj,   fdd2d    ) 
     601         fdd2d(:,:)      = 0.0      !! 
     602      ENDIF       
     603      IF( med_diag%AEOLIAN%dgsave ) THEN 
     604         CALL wrk_alloc( jpi, jpj,   ffetop2d    ) 
     605         ffetop2d(:,:)      = 0.0      !! 
     606      ENDIF 
     607      IF( med_diag%BENTHIC%dgsave ) THEN 
     608         CALL wrk_alloc( jpi, jpj,    ffebot2d   ) 
     609         ffebot2d(:,:)      = 0.0      !! 
     610      ENDIF 
     611      IF( med_diag%SCAVENGE%dgsave ) THEN 
     612         CALL wrk_alloc( jpi, jpj,   ffescav2d    ) 
     613         ffescav2d(:,:)      = 0.0      !! 
     614      ENDIF 
     615      IF( med_diag%PN_JLIM%dgsave ) THEN 
     616         CALL wrk_alloc( jpi, jpj,   fjln2d    ) 
     617         fjln2d(:,:)      = 0.0      !! 
     618      ENDIF 
     619      IF( med_diag%PN_NLIM%dgsave ) THEN 
     620         CALL wrk_alloc( jpi, jpj,   fnln2d    ) 
     621         fnln2d(:,:)      = 0.0      !! 
     622      ENDIF 
     623      IF( med_diag%PN_FELIM%dgsave ) THEN 
     624         CALL wrk_alloc( jpi, jpj,   ffln2d    ) 
     625         ffln2d(:,:)      = 0.0      !! 
     626      ENDIF 
     627      IF( med_diag%PD_JLIM%dgsave ) THEN 
     628         CALL wrk_alloc( jpi, jpj,   fjld2d    ) 
     629         fjld2d(:,:)      = 0.0      !! 
     630      ENDIF 
     631      IF( med_diag%PD_NLIM%dgsave ) THEN 
     632         CALL wrk_alloc( jpi, jpj,   fnld2d    ) 
     633         fnld2d(:,:)      = 0.0      !! 
     634      ENDIF 
     635      IF( med_diag%PD_FELIM%dgsave ) THEN 
     636         CALL wrk_alloc( jpi, jpj,   ffld2d    ) 
     637         ffld2d(:,:)      = 0.0      !! 
     638      ENDIF 
     639      IF( med_diag%PD_SILIM%dgsave ) THEN 
     640         CALL wrk_alloc( jpi, jpj,   fsld2d2    ) 
     641         fsld2d2(:,:)      = 0.0      !! 
     642      ENDIF 
     643      IF( med_diag%PDSILIM2%dgsave ) THEN 
     644         CALL wrk_alloc( jpi, jpj,   fsld2d    ) 
     645         fsld2d(:,:)      = 0.0      !! 
     646      ENDIF 
     647      !!  
     648      IF( med_diag%TOTREG_N%dgsave ) THEN 
     649         CALL wrk_alloc( jpi, jpj,   fregen2d    ) 
     650         fregen2d(:,:)      = 0.0      !! 
     651      ENDIF 
     652      IF( med_diag%TOTRG_SI%dgsave ) THEN 
     653         CALL wrk_alloc( jpi, jpj,   fregensi2d    ) 
     654         fregensi2d(:,:)      = 0.0      !! 
     655      ENDIF 
     656                !!  
     657      IF( med_diag%FASTN%dgsave ) THEN 
     658         CALL wrk_alloc( jpi, jpj,   ftempn2d    ) 
     659         ftempn2d(:,:)      = 0.0      !! 
     660      ENDIF 
     661      IF( med_diag%FASTSI%dgsave ) THEN 
     662         CALL wrk_alloc( jpi, jpj,   ftempsi2d    ) 
     663         ftempsi2d(:,:)      = 0.0      !! 
     664      ENDIF 
     665      IF( med_diag%FASTFE%dgsave ) THEN 
     666         CALL wrk_alloc( jpi, jpj,  ftempfe2d     ) 
     667         ftempfe2d(:,:)      = 0.0      !! 
     668      ENDIF 
     669      IF( med_diag%FASTC%dgsave ) THEN 
     670         CALL wrk_alloc( jpi, jpj,  ftempc2d     ) 
     671         ftempc2d(:,:)      = 0.0      !! 
     672      ENDIF 
     673      IF( med_diag%FASTCA%dgsave ) THEN 
     674         CALL wrk_alloc( jpi, jpj,   ftempca2d    ) 
     675         ftempca2d(:,:)      = 0.0      !! 
     676      ENDIF      
     677      !!  
     678      IF( med_diag%REMINN%dgsave ) THEN 
     679         CALL wrk_alloc( jpi, jpj,    freminn2d   ) 
     680         freminn2d(:,:)      = 0.0      !! 
     681      ENDIF 
     682      IF( med_diag%REMINSI%dgsave ) THEN 
     683         CALL wrk_alloc( jpi, jpj,    freminsi2d   ) 
     684         freminsi2d(:,:)      = 0.0      !! 
     685      ENDIF 
     686      IF( med_diag%REMINFE%dgsave ) THEN 
     687         CALL wrk_alloc( jpi, jpj,    freminfe2d   ) 
     688         freminfe2d(:,:)      = 0.0      !! 
     689      ENDIF 
     690      IF( med_diag%REMINC%dgsave ) THEN 
     691         CALL wrk_alloc( jpi, jpj,   freminc2d    ) 
     692         freminc2d(:,:)      = 0.0      !!  
     693      ENDIF 
     694      IF( med_diag%REMINCA%dgsave ) THEN 
     695         CALL wrk_alloc( jpi, jpj,   freminca2d    ) 
     696         freminca2d(:,:)      = 0.0      !! 
     697      ENDIF 
     698# if defined key_roam                   
     699      IF( med_diag%RR_0100%dgsave ) THEN 
     700         CALL wrk_alloc( jpi, jpj,   ffastca2d    ) 
     701         ffastca2d(:,:)      = 0.0      !! 
     702      ENDIF       
     703      IF( med_diag%RIV_N%dgsave ) THEN 
     704         CALL wrk_alloc( jpi, jpj,    rivn2d   ) 
     705         rivn2d(:,:)      = 0.0      !! 
     706      ENDIF 
     707      IF( med_diag%RIV_SI%dgsave ) THEN 
     708         CALL wrk_alloc( jpi, jpj,    rivsi2d   ) 
     709         rivsi2d(:,:)      = 0.0      !! 
     710      ENDIF 
     711      IF( med_diag%RIV_C%dgsave ) THEN 
     712         CALL wrk_alloc( jpi, jpj,   rivc2d    ) 
     713         rivc2d(:,:)      = 0.0      !! 
     714      ENDIF 
     715      IF( med_diag%RIV_ALK%dgsave ) THEN 
     716         CALL wrk_alloc( jpi, jpj,    rivalk2d   ) 
     717         rivalk2d(:,:)      = 0.0      !! 
     718      ENDIF 
     719      IF( med_diag%DETC%dgsave ) THEN 
     720         CALL wrk_alloc( jpi, jpj,    fslowc2d   ) 
     721         fslowc2d(:,:)      = 0.0      !! 
     722      ENDIF  
     723      IF( med_diag%PN_LLOSS%dgsave ) THEN 
     724         CALL wrk_alloc( jpi, jpj,    fdpn22d   ) 
     725         fdpn22d(:,:)      = 0.0      !! 
     726      ENDIF 
     727      IF( med_diag%PD_LLOSS%dgsave ) THEN 
     728         CALL wrk_alloc( jpi, jpj,    fdpd22d   ) 
     729         fdpd22d(:,:)      = 0.0      !! 
     730      ENDIF 
     731      IF( med_diag%ZI_LLOSS%dgsave ) THEN 
     732         CALL wrk_alloc( jpi, jpj,    fdzmi22d   ) 
     733         fdzmi22d(:,:)      = 0.0      !! 
     734      ENDIF 
     735      IF( med_diag%ZE_LLOSS%dgsave ) THEN 
     736         CALL wrk_alloc( jpi, jpj,   fdzme22d    ) 
     737         fdzme22d(:,:)      = 0.0      !! 
     738      ENDIF 
     739      IF( med_diag%ZI_MES_N%dgsave ) THEN    
     740         CALL wrk_alloc( jpi, jpj,   zimesn2d    ) 
     741         zimesn2d(:,:)      = 0.0      !! 
     742      ENDIF 
     743      IF( med_diag%ZI_MES_D%dgsave ) THEN 
     744      CALL wrk_alloc( jpi, jpj,    zimesd2d   ) 
     745         zimesd2d(:,:)      = 0.0      !! 
     746      ENDIF 
     747      IF( med_diag%ZI_MES_C%dgsave ) THEN 
     748      CALL wrk_alloc( jpi, jpj,    zimesc2d   ) 
     749         zimesc2d(:,:)      = 0.0      !! 
     750      ENDIF 
     751      IF( med_diag%ZI_MESDC%dgsave ) THEN 
     752      CALL wrk_alloc( jpi, jpj,    zimesdc2d   ) 
     753         zimesdc2d(:,:)      = 0.0      !! 
     754      ENDIF 
     755      IF( med_diag%ZI_EXCR%dgsave ) THEN 
     756      CALL wrk_alloc( jpi, jpj,     ziexcr2d  ) 
     757         ziexcr2d(:,:)      = 0.0      !! 
     758      ENDIF 
     759      IF( med_diag%ZI_RESP%dgsave ) THEN 
     760         CALL wrk_alloc( jpi, jpj,    ziresp2d   ) 
     761         ziresp2d(:,:)      = 0.0      !! 
     762      ENDIF 
     763      IF( med_diag%ZI_GROW%dgsave ) THEN 
     764         CALL wrk_alloc( jpi, jpj,    zigrow2d   ) 
     765         zigrow2d(:,:)      = 0.0      !! 
     766      ENDIF 
     767      IF( med_diag%ZE_MES_N%dgsave ) THEN 
     768         CALL wrk_alloc( jpi, jpj,   zemesn2d    ) 
     769         zemesn2d(:,:)      = 0.0      !! 
     770      ENDIF 
     771      IF( med_diag%ZE_MES_D%dgsave ) THEN 
     772         CALL wrk_alloc( jpi, jpj,    zemesd2d   ) 
     773         zemesd2d(:,:)      = 0.0      !! 
     774      ENDIF 
     775      IF( med_diag%ZE_MES_C%dgsave ) THEN 
     776         CALL wrk_alloc( jpi, jpj,    zemesc2d   ) 
     777         zemesc2d(:,:)      = 0.0      !! 
     778      ENDIF 
     779      IF( med_diag%ZE_MESDC%dgsave ) THEN 
     780         CALL wrk_alloc( jpi, jpj,    zemesdc2d   ) 
     781         zemesdc2d(:,:)      = 0.0      !! 
     782      ENDIF 
     783      IF( med_diag%ZE_EXCR%dgsave ) THEN 
     784         CALL wrk_alloc( jpi, jpj,    zeexcr2d   ) 
     785         zeexcr2d(:,:)      = 0.0      !! 
     786      ENDIF                   
     787      IF( med_diag%ZE_RESP%dgsave ) THEN 
     788         CALL wrk_alloc( jpi, jpj,    zeresp2d   ) 
     789         zeresp2d(:,:)      = 0.0      !! 
     790      ENDIF 
     791      IF( med_diag%ZE_GROW%dgsave ) THEN 
     792         CALL wrk_alloc( jpi, jpj,    zegrow2d   ) 
     793         zegrow2d(:,:)      = 0.0      !! 
     794      ENDIF 
     795      IF( med_diag%MDETC%dgsave ) THEN 
     796         CALL wrk_alloc( jpi, jpj,   mdetc2d    ) 
     797         mdetc2d(:,:)      = 0.0      !! 
     798      ENDIF 
     799      IF( med_diag%GMIDC%dgsave ) THEN 
     800         CALL wrk_alloc( jpi, jpj,    gmidc2d   ) 
     801         gmidc2d(:,:)      = 0.0      !! 
     802      ENDIF 
     803      IF( med_diag%GMEDC%dgsave ) THEN 
     804         CALL wrk_alloc( jpi, jpj,    gmedc2d   ) 
     805         gmedc2d(:,:)      = 0.0      !! 
     806      ENDIF 
     807      IF( med_diag%ATM_PCO2%dgsave ) THEN 
     808         CALL wrk_alloc( jpi, jpj,    f_pco2a2d   ) 
     809         f_pco2a2d(:,:)      = 0.0      !! 
     810      ENDIF 
     811      IF( med_diag%OCN_PCO2%dgsave ) THEN 
     812         CALL wrk_alloc( jpi, jpj,    f_pco2w2d   ) 
     813         f_pco2w2d(:,:)      = 0.0      !! 
     814      ENDIF 
     815      IF( med_diag%CO2FLUX%dgsave ) THEN 
     816         CALL wrk_alloc( jpi, jpj,    f_co2flux2d   ) 
     817         f_co2flux2d(:,:)      = 0.0      !! 
     818      ENDIF 
     819      IF( med_diag%TCO2%dgsave ) THEN 
     820         CALL wrk_alloc( jpi, jpj,   f_TDIC2d    ) 
     821         f_TDIC2d(:,:)      = 0.0      !! 
     822      ENDIF 
     823      IF( med_diag%TALK%dgsave ) THEN 
     824         CALL wrk_alloc( jpi, jpj,    f_TALK2d   ) 
     825         f_TALK2d(:,:)      = 0.0      !! 
     826      ENDIF 
     827      IF( med_diag%KW660%dgsave ) THEN 
     828         CALL wrk_alloc( jpi, jpj,    f_kw6602d   ) 
     829         f_kw6602d(:,:)      = 0.0      !! 
     830      ENDIF 
     831      IF( med_diag%ATM_PP0%dgsave ) THEN 
     832         CALL wrk_alloc( jpi, jpj,    f_pp02d   ) 
     833         f_pp02d(:,:)      = 0.0      !! 
     834      ENDIF 
     835      IF( med_diag%O2FLUX%dgsave ) THEN 
     836         CALL wrk_alloc( jpi, jpj,   f_o2flux2d    ) 
     837         f_o2flux2d(:,:)      = 0.0      !! 
     838      ENDIF 
     839      IF( med_diag%O2SAT%dgsave ) THEN 
     840         CALL wrk_alloc( jpi, jpj,    f_o2sat2d   ) 
     841         f_o2sat2d(:,:)      = 0.0      !! 
     842      ENDIF  
     843      !! 
     844      IF( med_diag%IBEN_N%dgsave ) THEN 
     845         CALL wrk_alloc( jpi, jpj,    iben_n2d  ) 
     846         iben_n2d(:,:)      = 0.0      !! 
     847      ENDIF 
     848      IF( med_diag%IBEN_FE%dgsave ) THEN 
     849         CALL wrk_alloc( jpi, jpj,   iben_fe2d   ) 
     850         iben_fe2d(:,:)      = 0.0     !! 
     851      ENDIF 
     852      IF( med_diag%IBEN_C%dgsave ) THEN 
     853         CALL wrk_alloc( jpi, jpj,   iben_c2d   ) 
     854         iben_c2d(:,:)      = 0.0      !! 
     855      ENDIF 
     856      IF( med_diag%IBEN_SI%dgsave ) THEN 
     857         CALL wrk_alloc( jpi, jpj,   iben_si2d   ) 
     858         iben_si2d(:,:)      = 0.0      !! 
     859      ENDIF 
     860      IF( med_diag%IBEN_CA%dgsave ) THEN 
     861         CALL wrk_alloc( jpi, jpj,   iben_ca2d   ) 
     862         iben_ca2d(:,:)      = 0.0      !! 
     863      ENDIF 
     864      IF( med_diag%OBEN_N%dgsave ) THEN 
     865         CALL wrk_alloc( jpi, jpj,    oben_n2d  ) 
     866         oben_n2d(:,:)      = 0.0      !! 
     867      ENDIF 
     868      IF( med_diag%OBEN_FE%dgsave ) THEN 
     869         CALL wrk_alloc( jpi, jpj,    oben_fe2d  ) 
     870         oben_fe2d(:,:)      = 0.0      !! 
     871      ENDIF 
     872      IF( med_diag%OBEN_C%dgsave ) THEN 
     873         CALL wrk_alloc( jpi, jpj,    oben_c2d  ) 
     874         oben_c2d(:,:)      = 0.0      !! 
     875      ENDIF 
     876      IF( med_diag%OBEN_SI%dgsave ) THEN 
     877         CALL wrk_alloc( jpi, jpj,    oben_si2d  ) 
     878         oben_si2d(:,:)      = 0.0      !! 
     879      ENDIF 
     880      IF( med_diag%OBEN_CA%dgsave ) THEN 
     881         CALL wrk_alloc( jpi, jpj,    oben_ca2d  ) 
     882         oben_ca2d(:,:)      = 0.0      !! 
     883      ENDIF 
     884      IF( med_diag%SFR_OCAL%dgsave ) THEN 
     885         CALL wrk_alloc( jpi, jpj,    sfr_ocal2d  ) 
     886         sfr_ocal2d(:,:)      = 0.0      !! 
     887      ENDIF 
     888      IF( med_diag%SFR_OARG%dgsave ) THEN 
     889         CALL wrk_alloc( jpi, jpj,    sfr_oarg2d  ) 
     890         sfr_oarg2d(:,:)      = 0.0      !! 
     891      ENDIF 
     892      IF( med_diag%LYSO_CA%dgsave ) THEN 
     893         CALL wrk_alloc( jpi, jpj,    lyso_ca2d  ) 
     894         lyso_ca2d(:,:)      = 0.0      !! 
     895      ENDIF 
     896      !!   
     897      IF (jdms .eq. 1) THEN 
     898         IF( med_diag%DMS_SURF%dgsave ) THEN 
     899            CALL wrk_alloc( jpi, jpj,  dms_surf2d     ) 
     900         dms_surf2d(:,:)      = 0.0      !! 
     901         ENDIF 
     902         IF( med_diag%DMS_ANDR%dgsave ) THEN 
     903            CALL wrk_alloc( jpi, jpj,   dms_andr2d    ) 
     904         dms_andr2d(:,:)      = 0.0      !! 
     905         ENDIF 
     906         IF( med_diag%DMS_SIMO%dgsave ) THEN 
     907            CALL wrk_alloc( jpi, jpj,  dms_simo2d     ) 
     908         dms_simo2d(:,:)      = 0.0      !! 
     909         ENDIF 
     910         IF( med_diag%DMS_ARAN%dgsave ) THEN 
     911            CALL wrk_alloc( jpi, jpj,   dms_aran2d    ) 
     912         dms_aran2d(:,:)      = 0.0      !! 
     913         ENDIF 
     914         IF( med_diag%DMS_HALL%dgsave ) THEN 
     915            CALL wrk_alloc( jpi, jpj,   dms_hall2d    ) 
     916         dms_hall2d(:,:)      = 0.0      !! 
     917         ENDIF 
     918      ENDIF    
     919# endif   
     920         IF( med_diag%TPP3%dgsave ) THEN 
     921             CALL wrk_alloc( jpi, jpj, jpk,       tpp3d ) 
     922             tpp3d(:,:,:)      = 0.0  !!  
     923         ENDIF 
     924         IF( med_diag%DETFLUX3%dgsave ) THEN 
     925             CALL wrk_alloc( jpi, jpj, jpk,        detflux3d ) 
     926             detflux3d(:,:,:)      = 0.0  !!  
     927         ENDIF 
     928          IF( med_diag%REMIN3N%dgsave ) THEN 
     929             CALL wrk_alloc( jpi, jpj, jpk,        remin3dn ) 
     930             remin3dn(:,:,:)      = 0.0  !!  
     931          ENDIF 
     932      ENDIF 
     933      !! lk_iomput                                    
     934      !! 
    457935# if defined key_axy_nancheck 
    458936      DO jn = 1,jptra 
    … …  
    486964# endif 
    487965 
     966# if defined key_debug_medusa 
     967      IF (lwp) write (numout,*) 'trc_bio_medusa: variables initialised and checked' 
     968      CALL flush(numout) 
     969# endif  
     970 
    488971# if defined key_roam 
    489972      !!---------------------------------------------------------------------- 
    … …  
    514997         f_pco2a = fq4 
    515998      endif 
    516 # if defined key_axy_pi_co2 
    517       f_pco2a = hist_pco2(1) 
    518       IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2  = FIXED' 
    519 # endif 
     999#  if defined key_axy_pi_co2 
     1000      !! f_pco2a = hist_pco2(1) 
     1001      f_pco2a = 284.725          !! OCMIP pre-industrial pCO2 
     1002#  endif 
    5201003      !! IF(lwp) WRITE(numout,*) ' MEDUSA nyear     =', nyear 
    5211004      !! IF(lwp) WRITE(numout,*) ' MEDUSA nsec_day  =', real(nsec_day) 
    … …  
    5291012# endif 
    5301013 
     1014# if defined key_debug_medusa 
     1015      IF (lwp) write (numout,*) 'trc_bio_medusa: ready for carbonate chemistry' 
     1016      IF (lwp) write (numout,*) 'trc_bio_medusa: kt = ', kt 
     1017      IF (lwp) write (numout,*) 'trc_bio_medusa: nittrc000 = ', nittrc000 
     1018      CALL flush(numout) 
     1019# endif  
     1020 
    5311021# if defined key_roam 
    532       !! AXY (20/11/14): alter to call on first MEDUSA timestep 
     1022      !! AXY (20/11/14): alter to call on first MEDUSA timestep and then every 
     1023      !!                 month (this is hardwired as 960 timesteps but should 
     1024      !!                 be calculated and done properly 
    5331025      !! IF( kt == nit000 .or. mod(kt,1920) == 0 ) THEN 
    534       IF( kt == nittrc000 .or. mod(kt,1920) == 0 ) THEN 
     1026      IF( kt == nittrc000 .or. mod(kt,960) == 0 ) THEN 
    5351027         !!---------------------------------------------------------------------- 
    5361028         !! Calculate the carbonate chemistry for the whole ocean on the first 
    … …  
    5401032         !! 
    5411033         IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt 
     1034         CALL flush(numout) 
    5421035         !! blank flags 
    5431036         i2_omcal(:,:) = 0 
    … …  
    5491042                  !! OPEN wet point IF..THEN loop 
    5501043                  if (tmask(ji,jj,jk).eq.1) then 
    551                      !! carbonate chemistry 
     1044                     !! do carbonate chemistry 
     1045                     !! 
    5521046                     fdep2 = fsdept(ji,jj,jk)           !! set up level midpoint 
     1047                     !! 
    5531048                     !! set up required state variables 
    5541049                     zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon 
    … …  
    5561051                     ztmp = tsn(ji,jj,jk,jp_tem)        !! temperature 
    5571052                     zsal = tsn(ji,jj,jk,jp_sal)        !! salinity 
     1053#  if defined key_mocsy 
     1054                     zsil = max(0.,trn(ji,jj,jk,jpsil))        !! silicic acid 
     1055                     zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 
     1056#  endif 
    5581057           !! 
    5591058           !! AXY (28/02/14): check input fields 
    … …  
    5711070                        ji, ',', jj, ',', jk, ') at time', kt 
    5721071                     endif 
     1072                     !! 
     1073                     !! blank input variables not used at this stage (they relate to air-sea flux) 
     1074                     f_kw660 = 1.0 
     1075                     f_pp0   = 1.0 
     1076                     !! 
    5731077                     !! calculate carbonate chemistry at grid cell midpoint 
    574                      CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, 5.0, f_pco2a, &    ! inputs 
    575                      f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),            &    ! outputs 
     1078#  if defined key_mocsy 
     1079                     !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
     1080                     !!                 chemistry package 
     1081                     CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,         &    ! inputs 
     1082                     f_pp0, fdep2, flatx, f_kw660, f_pco2a, 1,                         &    ! inputs 
     1083                     f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),   &    ! outputs 
     1084                     f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,             &    ! outputs 
     1085                     f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,                &    ! outputs 
     1086                     f_co2starair, f_co2flux, f_dpco2 )                                     ! outputs 
     1087                     !! 
     1088                     f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 
     1089                     f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg 
     1090                     f_dcf  = f_rhosw 
     1091#  else 
     1092                     !! AXY (22/06/15): use old PML carbonate chemistry package (the 
     1093                     !!                 MEDUSA-2 default) 
     1094                     CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, f_kw660,      &    ! inputs 
     1095                     f_pco2a, f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),   &    ! outputs 
    5761096                     f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters)      ! outputs 
    5771097                     !!  
    … …  
    5811101                        iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 
    5821102                     endif 
     1103#  endif 
     1104                     !! 
    5831105                     !! store 3D outputs 
    5841106                     f3_pH(ji,jj,jk)    = f_ph 
    … …  
    5881110                     f3_omcal(ji,jj,jk) = f_omcal(ji,jj) 
    5891111                     f3_omarg(ji,jj,jk) = f_omarg(ji,jj) 
     1112                     !! 
    5901113                     !! CCD calculation: calcite 
    5911114                     if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then 
    … …  
    6071130                        i2_omcal(ji,jj)   = 1 
    6081131                     endif 
     1132                     !! 
    6091133                     !! CCD calculation: aragonite 
    6101134                     if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then 
    … …  
    6331157# endif 
    6341158 
     1159# if defined key_debug_medusa 
     1160      IF (lwp) write (numout,*) 'trc_bio_medusa: ready for full domain calculations' 
     1161      CALL flush(numout) 
     1162# endif  
     1163 
    6351164      !!---------------------------------------------------------------------- 
    6361165      !! MEDUSA has unified equation through the water column 
    … …  
    6561185            !! OPEN wet point IF..THEN loop 
    6571186            if (tmask(ji,jj,jk).eq.1) then                
    658  
    6591187               !!====================================================================== 
    6601188               !! SETUP LOCAL GRID CELL 
    … …  
    7851313               if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then 
    7861314                  IF (lwp) write (numout,*) '------------------------------' 
    787                   IF (lwp) write (numout,*) 'dustmo(1) = ', dustmo(ji,jj,1) 
    788                   IF (lwp) write (numout,*) 'dustmo(2) = ', dustmo(ji,jj,2) 
    7891315                  IF (lwp) write (numout,*) 'dust      = ', dust(ji,jj) 
    7901316               endif 
    … …  
    7921318 
    7931319               !! sum tracers for inventory checks 
    794                ftot_n  = fthk * ( zphn + zphd + zzmi + zzme + zdet + zdin ) 
    795                ftot_si = fthk * ( zpds + zsil ) 
    796                ftot_fe = fthk * ( xrfn * ( zphn + zphd + zzmi + zzme + zdet ) + zfer ) 
     1320               IF( lk_iomput ) THEN 
     1321                  IF ( med_diag%INVTN%dgsave )   THEN 
     1322                     ftot_n(ji,jj)  = ftot_n(ji,jj) + & 
     1323                             (fthk * ( zphn + zphd + zzmi + zzme + zdet + zdin ) ) 
     1324                  ENDIF 
     1325                  IF ( med_diag%INVTSI%dgsave )  THEN 
     1326                     ftot_si(ji,jj) = ftot_si(ji,jj) + &  
     1327                             (fthk * ( zpds + zsil ) ) 
     1328                  ENDIF 
     1329                  IF ( med_diag%INVTFE%dgsave )  THEN 
     1330                     ftot_fe(ji,jj) = ftot_fe(ji,jj) + &  
     1331                             (fthk * ( xrfn * ( zphn + zphd + zzmi + zzme + zdet ) + zfer ) ) 
     1332                  ENDIF 
    7971333# if defined key_roam 
    798                ftot_c  = fthk * ( (xthetapn * zphn) + (xthetapd * zphd) + & 
    799                          (xthetazmi * zzmi) + (xthetazme * zzme) + zdtc + & 
    800                          zdic ) 
    801                ftot_a  = fthk * ( zalk ) 
    802                ftot_o2 = fthk * ( zoxy ) 
    803 # endif 
     1334                  IF ( med_diag%INVTC%dgsave )  THEN 
     1335                     ftot_c(ji,jj)  = ftot_c(ji,jj) + &  
     1336                             (fthk * ( (xthetapn * zphn) + (xthetapd * zphd) + & 
     1337                             (xthetazmi * zzmi) + (xthetazme * zzme) + zdtc +   & 
     1338                             zdic ) ) 
     1339                  ENDIF 
     1340                  IF ( med_diag%INVTALK%dgsave ) THEN 
     1341                     ftot_a(ji,jj)  = ftot_a(ji,jj) + (fthk * ( zalk ) ) 
     1342                  ENDIF 
     1343                  IF ( med_diag%INVTO2%dgsave )  THEN 
     1344                     ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fthk * ( zoxy ) ) 
     1345                  ENDIF 
     1346# endif 
     1347               ENDIF 
     1348 
    8041349               CALL flush(numout) 
    8051350 
    … …  
    8141359                  !!---------------------------------------------------------------------- 
    8151360                  !! 
    816                   !! a bit of set up ... 
    817                   ! f_uwind = zwnd_i(ji,jj) 
    818                   ! f_vwind = zwnd_j(ji,jj) 
    8191361                  !! AXY (17/07/14): zwind_i and zwind_j do not exist in this 
    8201362                  !!                 version of NEMO because it does not include 
    … …  
    8271369                  !!                 revisited when MEDUSA properly interacts 
    8281370                  !!                 with UKESM1 physics 
    829                   ! f_uwind = zwind_i(ji,jj) 
    830                   ! f_vwind = zwind_j(ji,jj) 
    831                   ! f_wind  = ((f_uwind**2.0) + (f_vwind**2.0))**0.5 
     1371                  !! 
    8321372                  f_wind  = wndm(ji,jj) 
    833                   !! AXY (17/07/14): the current oxygen code takes in separate 
    834                   !!                 U and V components of the wind; to avoid 
    835                   !!                 the need to change this, calculate these 
    836                   !!                 components based on wndm; again, this is 
    837                   !!                 not ideal, but should suffice as a 
    838                   !!                 temporary measure; in the long-term all 
    839                   !!                 of MEDUSA's air-sea gas exchange terms 
    840                   !!                 will be revisited to ensure that they are 
    841                   !!                 valid and self-consistent; and the CO2 
    842                   !!                 code will be wholly replaced with a more 
    843                   !!                 up-to-date parameterisation 
    844                   f_uwind = ((f_wind**2.0) / 2.0)**0.5 
    845                   f_vwind = f_uwind 
     1373                  !! 
     1374                  !! AXY (23/06/15): as part of an effort to update the carbonate chemistry 
     1375                  !!                 in MEDUSA, the gas transfer velocity used in the carbon 
     1376                  !!                 and oxygen cycles has been harmonised and is calculated 
     1377                  !!                 by the same function here; this harmonisation includes 
     1378                  !!                 changes to the PML carbonate chemistry scheme so that 
     1379                  !!                 it too makes use of the same gas transfer velocity; the 
     1380                  !!                 preferred parameterisation of this is Wanninkhof (2014), 
     1381                  !!                 option 7 
     1382                  !! 
     1383#   if defined key_debug_medusa 
     1384                     IF (lwp) write (numout,*) 'trc_bio_medusa: entering gas_transfer' 
     1385                     CALL flush(numout) 
     1386#   endif 
     1387                  CALL gas_transfer( f_wind, 1, 7, &  ! inputs 
     1388                                     f_kw660 )        ! outputs 
     1389#   if defined key_debug_medusa 
     1390                     IF (lwp) write (numout,*) 'trc_bio_medusa: exiting gas_transfer' 
     1391                     CALL flush(numout) 
     1392#   endif 
     1393                  !! 
     1394                  !! air pressure (atm); ultimately this will use air pressure at the base 
     1395                  !! of the UKESM1 atmosphere  
     1396                  !!                                      
    8461397                  f_pp0   = 1.0 
     1398                  !! 
    8471399                  !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp    =', ztmp 
    8481400                  !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_i =', zwind_i(ji,jj) 
    … …  
    8521404                  !! 
    8531405#  if defined key_axy_carbchem 
     1406#   if defined key_mocsy 
     1407                  !! 
     1408                  !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 
     1409                  !!                 chemistry package; note that depth is set to 
     1410                  !!                 zero in this call 
     1411                  CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho,        &  ! inputs 
     1412                  f_pp0, 0.0, flatx, f_kw660, f_pco2a, 1,                          &  ! inputs 
     1413                  f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj),  &  ! outputs 
     1414                  f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut,            &  ! outputs 
     1415                  f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0,               &  ! outputs 
     1416                  f_co2starair, f_co2flux, f_dpco2 )                                  ! outputs 
     1417                  !! 
     1418                  f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 
     1419                  f_TALK = (zalk / f_rhosw) * 1000. !  meq / m3 ->  ueq / kg 
     1420                  f_dcf  = f_rhosw 
     1421#   else                   
    8541422                  iters = 0 
    8551423                  !! 
    8561424                  !! carbon dioxide (CO2); Jerry Blackford code (ostensibly OCMIP-2, but not) 
    857                   CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, 0.0, f_wind, f_pco2a, &     ! inputs 
    858                   f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),             &     ! outputs 
    859                   f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters )       ! outputs 
     1425                  CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, 0.0, f_kw660, f_pco2a,  &  ! inputs 
     1426                  f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj),               &  ! outputs 
     1427                  f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters )      ! outputs 
    8601428                  !! 
    8611429                  !! AXY (09/01/14): removed iteration and NaN checks; these have 
    … …  
    8691437                     iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 
    8701438                  endif 
     1439#   endif 
    8711440#  else 
    8721441                  !! AXY (18/04/13): switch off carbonate chemistry calculations; provide 
    … …  
    8821451                  f_TDIC         = zdic 
    8831452                  f_TALK         = zalk 
    884                   f_dcf          = 1. 
     1453                  f_dcf          = 1.026 
    8851454                  f_henry        = 1. 
     1455                  !! AXY (23/06/15): add in some extra MOCSY diagnostics 
     1456                  f_fco2w        = fpco2a 
     1457                  f_BetaD        = 1. 
     1458                  f_rhosw        = 1.026 
     1459                  f_opres        = 0. 
     1460                  f_insitut      = ztmp 
     1461                  f_pco2atm      = fpco2a 
     1462                  f_fco2atm      = fpco2a 
     1463                  f_schmidtco2   = 660. 
     1464                  f_kwco2        = 0. 
     1465                  f_K0           = 0. 
     1466                  f_co2starair   = fpco2a 
     1467                  f_dpco2        = 0. 
    8861468#  endif 
    8871469                  !! 
    888                   !! already in right units; correct for sea-ice; divide through by layer thickness 
    889                   f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux / fthk 
     1470                  !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide through by layer thickness 
     1471                  f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux * 86400. / fthk 
    8901472                  !! 
    8911473                  !! oxygen (O2); OCMIP-2 code 
    892                   CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk, &  ! inputs 
    893                   f_kw660, f_o2flux, f_o2sat )                                                     ! outputs 
    894                   !! 
    895                   !! mol/m3/s -> mmol/m3/d; correct for sea-ice 
    896                   f_o2flux  = (1. - fr_i(ji,jj)) * f_o2flux * 1000. * 60. * 60. * 24.  
    897                   f_o2sat   = f_o2sat  * 1000. 
     1474                  !! AXY (23/06/15): amend input list for oxygen to account for common gas 
     1475                  !!                 transfer velocity 
     1476                  !! CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk,  &  ! inputs 
     1477                  !! f_kw660, f_o2flux, f_o2sat )                                                      ! outputs 
     1478                  CALL trc_oxy_medusa( ztmp, zsal, f_kw660, f_pp0, zoxy,  &  ! inputs 
     1479                  f_kwo2, f_o2flux, f_o2sat )                                ! outputs 
     1480                  !! 
     1481                  !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide through by layer thickness 
     1482                  f_o2flux  = (1. - fr_i(ji,jj)) * f_o2flux * 86400. / fthk 
    8981483                  !! 
    8991484                  !! Jpalm (08-2014) 
    … …  
    9111496                  !! 
    9121497                  IF (jdms .eq. 1) THEN 
    913                   !! 
    914                      !! CALL trc_dms_medusa( zchn, zchd, hmld(ji,jj), &                            !! inputs 
    915                      !! dms_surf )                                                                 !! outputs 
    916                      CALL trc_dms_medusa( zchn, zchd, hmld(ji,jj), qsr(ji,jj), zdin, &             !! inputs 
    917                      dms_surf, dms_andr, dms_simo, dms_aran, dms_hall )                            !! outputs 
     1498                     !! 
     1499                     !! feed in correct inputs 
     1500                     if (jdms_input .eq. 0) then 
     1501                        !! use instantaneous inputs 
     1502                        CALL trc_dms_medusa( zchn, zchd, hmld(ji,jj), qsr(ji,jj), zdin, &  ! inputs 
     1503                        dms_andr, dms_simo, dms_aran, dms_hall )                           ! outputs 
     1504                     else 
     1505                        !! use diel-average inputs 
     1506                        CALL trc_dms_medusa( zn_dms_chn(ji,jj), zn_dms_chd(ji,jj), &  ! inputs 
     1507                        zn_dms_mld(ji,jj), zn_dms_qsr(ji,jj), zn_dms_din(ji,jj),   &  ! inputs 
     1508                        dms_andr, dms_simo, dms_aran, dms_hall )                      ! outputs 
     1509                     endif 
     1510                     !! 
     1511                     !! assign correct output to variable passed to atmosphere 
     1512                     if     (jdms_model .eq. 1) then 
     1513                        dms_surf = dms_andr 
     1514                     elseif (jdms_model .eq. 2) then 
     1515                        dms_surf = dms_simo 
     1516                     elseif (jdms_model .eq. 3) then 
     1517                        dms_surf = dms_aran 
     1518                     elseif (jdms_model .eq. 4) then 
     1519                        dms_surf = dms_hall 
     1520                     endif 
     1521                     !! 
     1522                     !! 2D diag through iom_use 
     1523                     IF( lk_iomput ) THEN 
     1524                       IF( med_diag%DMS_SURF%dgsave ) THEN 
     1525                         dms_surf2d(ji,jj) = dms_surf 
     1526                       ENDIF 
     1527                       IF( med_diag%DMS_ANDR%dgsave ) THEN 
     1528                         dms_andr2d(ji,jj) = dms_andr 
     1529                       ENDIF 
     1530                       IF( med_diag%DMS_SIMO%dgsave ) THEN 
     1531                         dms_simo2d(ji,jj) = dms_simo 
     1532                       ENDIF 
     1533                       IF( med_diag%DMS_ARAN%dgsave ) THEN 
     1534                         dms_aran2d(ji,jj) = dms_aran 
     1535                       ENDIF 
     1536                       IF( med_diag%DMS_HALL%dgsave ) THEN 
     1537                         dms_hall2d(ji,jj) = dms_hall 
     1538                       ENDIF 
     1539#   if defined key_debug_medusa 
     1540                       IF (lwp) write (numout,*) 'trc_bio_medusa: finnish calculating dms' 
     1541                     CALL flush(numout) 
     1542#   endif  
     1543                     ENDIF 
     1544                     !! End iom 
    9181545                  ENDIF 
    9191546                  !! End DMS Loop 
     1547                  !! 
     1548                  !! store 2D outputs 
     1549                  IF ( lk_iomput ) THEN 
     1550                      IF( med_diag%ATM_PCO2%dgsave ) THEN 
     1551                         f_pco2a2d(ji,jj) = f_pco2a 
     1552                      ENDIF 
     1553                      IF( med_diag%OCN_PCO2%dgsave ) THEN 
     1554                         f_pco2w2d(ji,jj) = f_pco2w 
     1555                      ENDIF 
     1556                      IF( med_diag%CO2FLUX%dgsave ) THEN 
     1557                         f_co2flux2d(ji,jj) = f_co2flux 
     1558                      ENDIF 
     1559                      IF( med_diag%TCO2%dgsave ) THEN 
     1560                         f_TDIC2d(ji,jj) = f_TDIC 
     1561                      ENDIF 
     1562                      IF( med_diag%TALK%dgsave ) THEN 
     1563                         f_TALK2d(ji,jj) = f_TALK 
     1564                      ENDIF 
     1565                      IF( med_diag%KW660%dgsave ) THEN 
     1566                         f_kw6602d(ji,jj) = f_kw660 
     1567                      ENDIF 
     1568                      IF( med_diag%ATM_PP0%dgsave ) THEN 
     1569                         f_pp02d(ji,jj) = f_pp0 
     1570                      ENDIF 
     1571                      IF( med_diag%O2FLUX%dgsave ) THEN 
     1572                         f_o2flux2d(ji,jj) = f_o2flux 
     1573                      ENDIF 
     1574                      IF( med_diag%O2SAT%dgsave ) THEN 
     1575                         f_o2sat2d(ji,jj) = f_o2sat 
     1576                      ENDIF 
     1577                  ENDIF 
     1578                  !!  
    9201579               endif 
    9211580               !! End jk = 1 loop within ROAM key  
    … …  
    9531612                  !! alkalinity are derived from continent-scale DIC estimates (Huang et al.,  
    9541613                  !! 2012) and some Arctic river alkalinity estimates (Katya?) 
    955                   !!       
     1614                  !!  
    9561615                  !! as of 19/07/12, riverine nutrients can now be spread vertically across  
    9571616                  !! several grid cells rather than just poured into the surface box; this 
    … …  
    12161875               endif 
    12171876               !! 
    1218                fprn_ml = (fprn * zphn * fthk * fq0) 
    1219                fprd_ml = (fprd * zphd * fthk * fq0) 
    1220  
     1877               fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn * zphn * fthk * fq0) 
     1878               fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd * zphd * fthk * fq0) 
     1879                
     1880               !!---------------------------------------------------------------------- 
     1881               !! Vertical Integral -- 
     1882               !!---------------------------------------------------------------------- 
     1883               ftot_pn(ji,jj)  = ftot_pn(ji,jj)  + (zphn * fthk)   !! vertical integral non-diatom phytoplankton 
     1884               ftot_pd(ji,jj)  = ftot_pd(ji,jj)  + (zphd * fthk)   !! vertical integral diatom phytoplankton 
     1885               ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk)   !! vertical integral microzooplankton 
     1886               ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk)   !! vertical integral mesozooplankton 
     1887               ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk)   !! vertical integral slow detritus, nitrogen 
     1888               ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk)   !! vertical integral slow detritus, carbon 
     1889                
    12211890               !!---------------------------------------------------------------------- 
    12221891               !! More chlorophyll calculations 
    … …  
    15352204               !! "free" iron concentration (and convert to mmol Fe / m3) 
    15362205               xFeF        = (xFeT - xFeL) * 1.e-3 
    1537                xFree       = xFeF / (zfer + tiny(zfer)) 
     2206               xFree(ji,jj)= xFeF / (zfer + tiny(zfer)) 
    15382207               !! 
    15392208               !! scavenging of iron (multiple schemes); I'm only really happy with the  
    … …  
    18422511                  IF (lwp) write (numout,*) 'ffetop(',jk,')  = ', ffetop 
    18432512                  IF (lwp) write (numout,*) 'ffebot(',jk,')  = ', ffebot 
    1844                   IF (lwp) write (numout,*) 'xFree(',jk,')   = ', xFree 
     2513                  IF (lwp) write (numout,*) 'xFree(',jk,')   = ', xFree(ji,jj) 
    18452514                  IF (lwp) write (numout,*) 'ffescav(',jk,') = ', ffescav 
    18462515               endif 
    … …  
    18752544               !! standard depths in the diagnostic outputs; needs to be 
    18762545               !! adjusted from per second to per day because of parameter vsed 
    1877                fslownflux = zdet * vsed * 86400. 
     2546               fslownflux(ji,jj) = zdet * vsed * 86400. 
    18782547# if defined key_roam 
    18792548               !! 
    … …  
    18882557               !! standard depths in the diagnostic outputs; needs to be 
    18892558               !! adjusted from per second to per day because of parameter vsed 
    1890                fslowcflux = zdtc * vsed * 86400. 
     2559               fslowcflux(ji,jj) = zdtc * vsed * 86400. 
    18912560# endif 
    18922561 
    … …  
    24013070                     f_fbenin_c(ji,jj)  = ffastc(ji,jj)             !! fast C -> benthic C                       (mol/m2) 
    24023071                  endif 
    2403                   fsedc    = ffastc(ji,jj)                          !! record seafloor C                         (mol/m2) 
     3072                  fsedc(ji,jj)   = ffastc(ji,jj)                          !! record seafloor C                         (mol/m2) 
    24043073                  ffastc(ji,jj)  = 0.0 
    24053074                  !! 
    … …  
    24133082                     f_fbenin_n(ji,jj)  = ffastn(ji,jj)             !! fast N -> benthic N                       (mol/m2) 
    24143083                  endif 
    2415                   fsedn    = ffastn(ji,jj)                          !! record seafloor N                         (mol/m2) 
     3084                  fsedn(ji,jj)   = ffastn(ji,jj)                          !! record seafloor N                         (mol/m2) 
    24163085                  ffastn(ji,jj)  = 0.0 
    24173086                  !! 
    … …  
    24243093                     f_fbenin_fe(ji,jj) = ffastfe(ji,jj)            !! fast Fe -> benthic Fe                     (mol/m2) 
    24253094                  endif 
    2426                   fsedfe   = ffastfe(ji,jj)                         !! record seafloor Fe                        (mol/m2) 
     3095                  fsedfe(ji,jj)  = ffastfe(ji,jj)                         !! record seafloor Fe                        (mol/m2) 
    24273096                  ffastfe(ji,jj) = 0.0 
    24283097                  !! 
    … …  
    24333102                     f_fbenin_si(ji,jj) = ffastsi(ji,jj)            !! fast Si -> benthic Si                     (mol/m2) 
    24343103                  endif 
    2435                   fsedsi   = ffastsi(ji,jj)                         !! record seafloor Si                        (mol/m2) 
     3104                  fsedsi(ji,jj)   = ffastsi(ji,jj)                         !! record seafloor Si                        (mol/m2) 
    24363105                  ffastsi(ji,jj) = 0.0 
    24373106                  !! 
    … …  
    24423111                     f_fbenin_ca(ji,jj) = ffastca(ji,jj)            !! fast Ca -> benthic Ca                     (mol/m2) 
    24433112                  endif 
    2444                   fsedca   = ffastca(ji,jj)                         !! record seafloor Ca                        (mol/m2) 
     3113                  fsedca(ji,jj)   = ffastca(ji,jj)                         !! record seafloor Ca                        (mol/m2) 
    24453114                  ffastca(ji,jj) = 0.0 
    24463115               endif 
    … …  
    26393308               !! 
    26403309               !! community respiration (does not include CaCO3 terms - obviously!) 
    2641                fcomm_resp = fc_prod 
     3310               fcomm_resp(ji,jj) = fcomm_resp(ji,jj) + fc_prod 
    26423311               !! 
    26433312               !! CaCO3 
    … …  
    28413510               endif                
    28423511 
     3512#   if defined key_debug_medusa 
     3513               IF (lwp) write (numout,*) '------' 
     3514               IF (lwp) write (numout,*) 'trc_bio_medusa: end all calculations' 
     3515               IF (lwp) write (numout,*) 'trc_bio_medusa: now outputs' 
     3516                     CALL flush(numout) 
     3517#   endif 
     3518 
    28433519# if defined key_axy_nancheck 
    28443520               !!---------------------------------------------------------------------- 
    … …  
    29173593# endif 
    29183594 
    2919                IF( ln_diatrc ) THEN 
     3595               IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
     3596         !!---------------------------------------------------------------------- 
     3597         !! Add in XML diagnostics stuff 
     3598         !!---------------------------------------------------------------------- 
     3599         !! 
     3600         !! ** 2D diagnostics 
     3601#   if defined key_debug_medusa 
     3602                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk loop' 
     3603                     CALL flush(numout) 
     3604#   endif 
     3605                  IF ( med_diag%PRN%dgsave ) THEN 
     3606                      fprn2d(ji,jj) = fprn2d(ji,jj) + (fprn  * zphn * fthk)  
     3607                  ENDIF 
     3608                  IF ( med_diag%MPN%dgsave ) THEN 
     3609                      fdpn2d(ji,jj) = fdpn2d(ji,jj) + (fdpn         * fthk) 
     3610                  ENDIF 
     3611                  IF ( med_diag%PRD%dgsave ) THEN 
     3612                      fprd2d(ji,jj) = fprd2d(ji,jj) + (fprd  * zphd * fthk) 
     3613                  ENDIF 
     3614                  IF( med_diag%MPD%dgsave ) THEN 
     3615                      fdpd2d(ji,jj) = fdpd2d(ji,jj) + (fdpd         * fthk)  
     3616                  ENDIF 
     3617                !  IF( med_diag%DSED%dgsave ) THEN 
     3618                !      CALL iom_put( "DSED"  , ftot_n ) 
     3619                !  ENDIF 
     3620                  IF( med_diag%OPAL%dgsave ) THEN 
     3621                      fprds2d(ji,jj) = fprds2d(ji,jj) + (fprds * zpds * fthk)  
     3622                  ENDIF 
     3623                  IF( med_diag%OPALDISS%dgsave ) THEN 
     3624                      fsdiss2d(ji,jj) = fsdiss2d(ji,jj) + (fsdiss  * fthk)   
     3625                  ENDIF 
     3626                  IF( med_diag%GMIPn%dgsave ) THEN 
     3627                      fgmipn2d(ji,jj) = fgmipn2d(ji,jj) + (fgmipn  * fthk)  
     3628                  ENDIF 
     3629                  IF( med_diag%GMID%dgsave ) THEN 
     3630                      fgmid2d(ji,jj) = fgmid2d(ji,jj) + (fgmid   * fthk)  
     3631                  ENDIF 
     3632                  IF( med_diag%MZMI%dgsave ) THEN 
     3633                      fdzmi2d(ji,jj) = fdzmi2d(ji,jj) + (fdzmi   * fthk)  
     3634                  ENDIF 
     3635                  IF( med_diag%GMEPN%dgsave ) THEN 
     3636                      fgmepn2d(ji,jj) = fgmepn2d(ji,jj) + (fgmepn  * fthk) 
     3637                  ENDIF 
     3638                  IF( med_diag%GMEPD%dgsave ) THEN 
     3639                      fgmepd2d(ji,jj) = fgmepd2d(ji,jj) + (fgmepd  * fthk)  
     3640                  ENDIF 
     3641                  IF( med_diag%GMEZMI%dgsave ) THEN 
     3642                      fgmezmi2d(ji,jj) = fgmezmi2d(ji,jj) + (fgmezmi * fthk)  
     3643                  ENDIF 
     3644                  IF( med_diag%GMED%dgsave ) THEN 
     3645                      fgmed2d(ji,jj) = fgmed2d(ji,jj) + (fgmed   * fthk)  
     3646                  ENDIF 
     3647                  IF( med_diag%MZME%dgsave ) THEN 
     3648                      fdzme2d(ji,jj) = fdzme2d(ji,jj) + (fdzme   * fthk)  
     3649                  ENDIF 
     3650                !  IF( med_diag%DEXP%dgsave ) THEN 
     3651                !      CALL iom_put( "DEXP"  , ftot_n ) 
     3652                !  ENDIF 
     3653                  IF( med_diag%DETN%dgsave ) THEN 
     3654                      fslown2d(ji,jj) = fslown2d(ji,jj) + (fslown  * fthk)   
     3655                  ENDIF 
     3656                  IF( med_diag%MDET%dgsave ) THEN 
     3657                      fdd2d(ji,jj) = fdd2d(ji,jj) + (fdd     * fthk)  
     3658                  ENDIF 
     3659                  IF( med_diag%AEOLIAN%dgsave ) THEN 
     3660                      ffetop2d(ji,jj) = ffetop2d(ji,jj) + (ffetop  * fthk)  
     3661                  ENDIF 
     3662                  IF( med_diag%BENTHIC%dgsave ) THEN 
     3663                      ffebot2d(ji,jj) = ffebot2d(ji,jj) + (ffebot  * fthk)  
     3664                  ENDIF 
     3665                  IF( med_diag%SCAVENGE%dgsave ) THEN 
     3666                      ffescav2d(ji,jj) = ffescav2d(ji,jj) + (ffescav * fthk)   
     3667                  ENDIF 
     3668                  IF( med_diag%PN_JLIM%dgsave ) THEN 
     3669                      fjln2d(ji,jj) = fjln2d(ji,jj) + (fjln  * zphn * fthk)  
     3670                  ENDIF 
     3671                  IF( med_diag%PN_NLIM%dgsave ) THEN 
     3672                      fnln2d(ji,jj) = fnln2d(ji,jj) + (fnln  * zphn * fthk)  
     3673                  ENDIF 
     3674                  IF( med_diag%PN_FELIM%dgsave ) THEN 
     3675                      ffln2d(ji,jj) = ffln2d(ji,jj) + (ffln  * zphn * fthk)  
     3676                  ENDIF 
     3677                  IF( med_diag%PD_JLIM%dgsave ) THEN 
     3678                      fjld2d(ji,jj) = fjld2d(ji,jj) + (fjld  * zphd * fthk)  
     3679                  ENDIF 
     3680                  IF( med_diag%PD_NLIM%dgsave ) THEN 
     3681                      fnld2d(ji,jj) = fnld2d(ji,jj) + (fnld  * zphd * fthk)  
     3682                  ENDIF 
     3683                  IF( med_diag%PD_FELIM%dgsave ) THEN 
     3684                      ffld2d(ji,jj) = ffld2d(ji,jj) + (ffld  * zphd * fthk)  
     3685                  ENDIF 
     3686                  IF( med_diag%PD_SILIM%dgsave ) THEN 
     3687                      fsld2d2(ji,jj) = fsld2d2(ji,jj) + (fsld2 * zphd * fthk)  
     3688                  ENDIF 
     3689                  IF( med_diag%PDSILIM2%dgsave ) THEN 
     3690                      fsld2d(ji,jj) = fsld2d(ji,jj) + (fsld  * zphd * fthk) 
     3691                  ENDIF 
     3692                !!  
     3693                  IF( med_diag%TOTREG_N%dgsave ) THEN 
     3694                      fregen2d(ji,jj) = fregen2d(ji,jj) + fregen 
     3695                  ENDIF 
     3696                  IF( med_diag%TOTRG_SI%dgsave ) THEN 
     3697                      fregensi2d(ji,jj) = fregensi2d(ji,jj) + fregensi 
     3698                  ENDIF 
     3699                !!  
     3700                  IF( med_diag%FASTN%dgsave ) THEN 
     3701                      ftempn2d(ji,jj) = ftempn2d(ji,jj) + (ftempn  * fthk) 
     3702                  ENDIF 
     3703                  IF( med_diag%FASTSI%dgsave ) THEN 
     3704                      ftempsi2d(ji,jj) = ftempsi2d(ji,jj) + (ftempsi * fthk) 
     3705                  ENDIF 
     3706                  IF( med_diag%FASTFE%dgsave ) THEN 
     3707                      ftempfe2d(ji,jj) =ftempfe2d(ji,jj)  + (ftempfe * fthk)   
     3708                  ENDIF 
     3709                  IF( med_diag%FASTC%dgsave ) THEN 
     3710                      ftempc2d(ji,jj) = ftempc2d(ji,jj) + (ftempc  * fthk) 
     3711                  ENDIF 
     3712                  IF( med_diag%FASTCA%dgsave ) THEN 
     3713                      ftempca2d(ji,jj) = ftempca2d(ji,jj) + (ftempca * fthk) 
     3714                  ENDIF 
     3715                !!  
     3716                  IF( med_diag%REMINN%dgsave ) THEN 
     3717                      freminn2d(ji,jj) = freminn2d(ji,jj) + (freminn  * fthk) 
     3718                  ENDIF 
     3719                  IF( med_diag%REMINSI%dgsave ) THEN 
     3720                      freminsi2d(ji,jj) = freminsi2d(ji,jj) + (freminsi * fthk) 
     3721                  ENDIF 
     3722                  IF( med_diag%REMINFE%dgsave ) THEN 
     3723                      freminfe2d(ji,jj)= freminfe2d(ji,jj) + (freminfe * fthk)  
     3724                  ENDIF 
     3725                  IF( med_diag%REMINC%dgsave ) THEN 
     3726                      freminc2d(ji,jj) = freminc2d(ji,jj) + (freminc  * fthk)  
     3727                  ENDIF 
     3728                  IF( med_diag%REMINCA%dgsave ) THEN 
     3729                      freminca2d(ji,jj) = freminca2d(ji,jj) + (freminca * fthk)  
     3730                  ENDIF 
     3731                !! 
     3732                !! 
     3733                !! 
     3734                !!   
     3735                !!  
     3736                !! 
     3737                !!  
     3738                !! 
     3739                !! 
     3740# if defined key_roam             
     3741                 IF (jk.eq.i0100) THEN 
     3742                     IF( med_diag%RR_0100%dgsave ) THEN 
     3743                         ffastca2d(ji,jj) =   & 
     3744                            ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
     3745                     ENDIF                      
     3746                 ELSE IF (jk.eq.i0500) THEN  
     3747                     IF( med_diag%RR_0500%dgsave ) THEN 
     3748                         ffastca2d(ji,jj) =   & 
     3749                            ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
     3750                     ENDIF                         
     3751                 ELSE IF (jk.eq.i1000) THEN 
     3752                     IF( med_diag%RR_1000%dgsave ) THEN 
     3753                         ffastca2d(ji,jj) =   & 
     3754                            ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
     3755                     ENDIF 
     3756                 ELSE IF (jk.eq.(mbathy(ji,jj)-1)) THEN 
     3757                     IF( med_diag%IBEN_N%dgsave ) THEN 
     3758                         iben_n2d(ji,jj) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj) 
     3759                     ENDIF 
     3760                     IF( med_diag%IBEN_FE%dgsave ) THEN 
     3761                         iben_fe2d(ji,jj) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj) 
     3762                     ENDIF 
     3763                     IF( med_diag%IBEN_C%dgsave ) THEN 
     3764                         iben_c2d(ji,jj) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj) 
     3765                     ENDIF 
     3766                     IF( med_diag%IBEN_SI%dgsave ) THEN 
     3767                         iben_si2d(ji,jj) = f_fbenin_si(ji,jj) 
     3768                     ENDIF 
     3769                     IF( med_diag%IBEN_CA%dgsave ) THEN 
     3770                         iben_ca2d(ji,jj) = f_fbenin_ca(ji,jj) 
     3771                     ENDIF 
     3772                     IF( med_diag%OBEN_N%dgsave ) THEN 
     3773                         oben_n2d(ji,jj) = f_benout_n(ji,jj) 
     3774                     ENDIF 
     3775                     IF( med_diag%OBEN_FE%dgsave ) THEN 
     3776                         oben_fe2d(ji,jj) = f_benout_fe(ji,jj) 
     3777                     ENDIF 
     3778                     IF( med_diag%OBEN_C%dgsave ) THEN 
     3779                         oben_c2d(ji,jj) = f_benout_c(ji,jj) 
     3780                     ENDIF 
     3781                     IF( med_diag%OBEN_SI%dgsave ) THEN 
     3782                         oben_si2d(ji,jj) = f_benout_si(ji,jj) 
     3783                     ENDIF 
     3784                     IF( med_diag%OBEN_CA%dgsave ) THEN 
     3785                         oben_ca2d(ji,jj) = f_benout_ca(ji,jj) 
     3786                     ENDIF 
     3787                     IF( med_diag%SFR_OCAL%dgsave ) THEN 
     3788                         sfr_ocal2d(ji,jj) = f3_omcal(ji,jj,jk) 
     3789                     ENDIF 
     3790                     IF( med_diag%SFR_OARG%dgsave ) THEN 
     3791                         sfr_oarg2d(ji,jj) =  f3_omarg(ji,jj,jk) 
     3792                     ENDIF 
     3793                     IF( med_diag%LYSO_CA%dgsave ) THEN 
     3794                         lyso_ca2d(ji,jj) = f_benout_lyso_ca(ji,jj) 
     3795                     ENDIF 
     3796                 ENDIF 
     3797                !! !! end bathy-1 diags 
     3798                !! 
     3799                  IF( med_diag%RIV_N%dgsave ) THEN 
     3800                      rivn2d(ji,jj) = rivn2d(ji,jj) +  (f_riv_loc_n * fthk) 
     3801                  ENDIF 
     3802                  IF( med_diag%RIV_SI%dgsave ) THEN 
     3803                      rivsi2d(ji,jj) = rivsi2d(ji,jj) +  (f_riv_loc_si * fthk) 
     3804                  ENDIF 
     3805                  IF( med_diag%RIV_C%dgsave ) THEN 
     3806                      rivc2d(ji,jj) = rivc2d(ji,jj) +  (f_riv_loc_c * fthk) 
     3807                  ENDIF 
     3808                  IF( med_diag%RIV_ALK%dgsave ) THEN 
     3809                      rivalk2d(ji,jj) = rivalk2d(ji,jj) +  (f_riv_loc_alk * fthk) 
     3810                  ENDIF 
     3811                  IF( med_diag%DETC%dgsave ) THEN 
     3812                      fslowc2d(ji,jj) = fslowc2d(ji,jj) + (fslowc  * fthk)    
     3813                  ENDIF 
     3814                !!  
     3815                !!               
     3816                !! 
     3817                  IF( med_diag%PN_LLOSS%dgsave ) THEN 
     3818                      fdpn22d(ji,jj) = fdpn22d(ji,jj) + (fdpn2  * fthk) 
     3819                  ENDIF 
     3820                  IF( med_diag%PD_LLOSS%dgsave ) THEN 
     3821                      fdpd22d(ji,jj) = fdpd22d(ji,jj) + (fdpd2  * fthk) 
     3822                  ENDIF 
     3823                  IF( med_diag%ZI_LLOSS%dgsave ) THEN 
     3824                      fdzmi22d(ji,jj) = fdzmi22d(ji,jj) + (fdzmi2 * fthk) 
     3825                  ENDIF 
     3826                  IF( med_diag%ZE_LLOSS%dgsave ) THEN 
     3827                      fdzme22d(ji,jj) = fdzme22d(ji,jj) + (fdzme2 * fthk) 
     3828                  ENDIF 
     3829                  IF( med_diag%ZI_MES_N%dgsave ) THEN 
     3830                      zimesn2d(ji,jj) = zimesn2d(ji,jj) +  & 
     3831                                      (xphi * (fgmipn + fgmid) * fthk) 
     3832                  ENDIF 
     3833                  IF( med_diag%ZI_MES_D%dgsave ) THEN 
     3834                      zimesd2d(ji,jj) = zimesd2d(ji,jj) + &  
     3835                                      ((1. - xbetan) * finmi * fthk) 
     3836                  ENDIF 
     3837                  IF( med_diag%ZI_MES_C%dgsave ) THEN 
     3838                      zimesc2d(ji,jj) = zimesc2d(ji,jj) + & 
     3839                             (xphi * ((xthetapn * fgmipn) + fgmidc) * fthk) 
     3840                  ENDIF 
     3841                  IF( med_diag%ZI_MESDC%dgsave ) THEN 
     3842                      zimesdc2d(ji,jj) = zimesdc2d(ji,jj) + & 
     3843                                       ((1. - xbetac) * ficmi * fthk) 
     3844                  ENDIF 
     3845                  IF( med_diag%ZI_EXCR%dgsave ) THEN 
     3846                      ziexcr2d(ji,jj) = ziexcr2d(ji,jj) +  (fmiexcr * fthk) 
     3847                  ENDIF 
     3848                  IF( med_diag%ZI_RESP%dgsave ) THEN 
     3849                      ziresp2d(ji,jj) = ziresp2d(ji,jj) +  (fmiresp * fthk) 
     3850                  ENDIF 
     3851                  IF( med_diag%ZI_GROW%dgsave ) THEN 
     3852                      zigrow2d(ji,jj) = zigrow2d(ji,jj) + (fmigrow * fthk) 
     3853                  ENDIF 
     3854                  IF( med_diag%ZE_MES_N%dgsave ) THEN 
     3855                      zemesn2d(ji,jj) = zemesn2d(ji,jj) + & 
     3856                          (xphi * (fgmepn + fgmepd + fgmezmi + fgmed) * fthk) 
     3857                  ENDIF 
     3858                  IF( med_diag%ZE_MES_D%dgsave ) THEN 
     3859                      zemesd2d(ji,jj) = zemesd2d(ji,jj) + & 
     3860                                      ((1. - xbetan) * finme * fthk) 
     3861                  ENDIF 
     3862                  IF( med_diag%ZE_MES_C%dgsave ) THEN 
     3863                      zemesc2d(ji,jj) = zemesc2d(ji,jj) +                         &  
     3864                            (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) +  & 
     3865                            (xthetazmi * fgmezmi) + fgmedc) * fthk) 
     3866                  ENDIF 
     3867                  IF( med_diag%ZE_MESDC%dgsave ) THEN 
     3868                      zemesdc2d(ji,jj) = zemesdc2d(ji,jj) +  & 
     3869                                       ((1. - xbetac) * ficme * fthk) 
     3870                  ENDIF 
     3871                  IF( med_diag%ZE_EXCR%dgsave ) THEN 
     3872                      zeexcr2d(ji,jj) = zeexcr2d(ji,jj) + (fmeexcr * fthk) 
     3873                  ENDIF 
     3874                  IF( med_diag%ZE_RESP%dgsave ) THEN 
     3875                      zeresp2d(ji,jj) = zeresp2d(ji,jj) + (fmeresp * fthk) 
     3876                  ENDIF 
     3877                  IF( med_diag%ZE_GROW%dgsave ) THEN 
     3878                      zegrow2d(ji,jj) = zegrow2d(ji,jj) + (fmegrow * fthk) 
     3879                  ENDIF 
     3880                  IF( med_diag%MDETC%dgsave ) THEN 
     3881                      mdetc2d(ji,jj) = mdetc2d(ji,jj) + (fddc * fthk) 
     3882                  ENDIF 
     3883                  IF( med_diag%GMIDC%dgsave ) THEN 
     3884                      gmidc2d(ji,jj) = gmidc2d(ji,jj) + (fgmidc * fthk) 
     3885                  ENDIF 
     3886                  IF( med_diag%GMEDC%dgsave ) THEN 
     3887                      gmedc2d(ji,jj) = gmedc2d(ji,jj) + (fgmedc  * fthk) 
     3888                  ENDIF 
     3889# endif                    
     3890                !!  
     3891         !! 
     3892         !! 
     3893         !! 
     3894         !! 
     3895         !! ** 3D diagnostics 
     3896                  IF( med_diag%TPP3%dgsave ) THEN 
     3897                      tpp3d(ji,jj,jk) =  (fprn + fprd) * zphn  
     3898                      !CALL iom_put( "TPP3"  , tpp3d ) 
     3899                  ENDIF 
     3900 
     3901                  IF( med_diag%REMIN3N%dgsave ) THEN 
     3902                      remin3dn(ji,jj,jk) = fregen + (freminn * fthk)  !! remineralisation 
     3903                      !CALL iom_put( "REMIN3N"  , remin3dn ) 
     3904                  ENDIF 
     3905                  !! IF( med_diag%PH3%dgsave ) THEN 
     3906                  !!     CALL iom_put( "PH3"  , f3_pH ) 
     3907                  !! ENDIF 
     3908                  !! IF( med_diag%OM_CAL3%dgsave ) THEN 
     3909                  !!     CALL iom_put( "OM_CAL3"  , f3_omcal ) 
     3910                  !! ENDIF 
     3911         !! 
     3912         !! 
     3913         !! ** Without using iom_use 
     3914               ELSE IF( ln_diatrc ) THEN 
     3915#   if defined key_debug_medusa 
     3916                  IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk ln_diatrc' 
     3917                  CALL flush(numout) 
     3918#   endif 
    29203919                  !!---------------------------------------------------------------------- 
    29213920                  !! Prepare 2D diagnostics 
    … …  
    29253924                  !!    IF (lwp) write (*,*) '*******!MEDUSA DIAADD!*******',kt 
    29263925                  !! endif      
    2927                   trc2d(ji,jj,1)  = trc2d(ji,jj,1)  + ftot_n                   !! nitrogen inventory 
    2928                   trc2d(ji,jj,2)  = trc2d(ji,jj,2)  + ftot_si                  !! silicon  inventory 
    2929                   trc2d(ji,jj,3)  = trc2d(ji,jj,3)  + ftot_fe                  !! iron     inventory 
     3926                  trc2d(ji,jj,1)  =  ftot_n(ji,jj)                             !! nitrogen inventory 
     3927                  trc2d(ji,jj,2)  =  ftot_si(ji,jj)                            !! silicon  inventory 
     3928                  trc2d(ji,jj,3)  =  ftot_fe(ji,jj)                            !! iron     inventory 
    29303929                  trc2d(ji,jj,4)  = trc2d(ji,jj,4)  + (fprn  * zphn * fthk)    !! non-diatom production 
    29313930                  trc2d(ji,jj,5)  = trc2d(ji,jj,5)  + (fdpn         * fthk)    !! non-diatom non-grazing losses 
    … …  
    29573956                  trc2d(ji,jj,31) = trc2d(ji,jj,31) + (fsld2 * zphd * fthk)    !! diatom     Si limitation term  
    29583957                  trc2d(ji,jj,32) = trc2d(ji,jj,32) + (fsld  * zphd * fthk)    !! diatom     Si uptake limitation term 
    2959                   if (jk.eq.i0100) trc2d(ji,jj,33) = fslownflux                !! slow detritus flux at  100 m 
    2960                   if (jk.eq.i0200) trc2d(ji,jj,34) = fslownflux                !! slow detritus flux at  200 m 
    2961                   if (jk.eq.i0500) trc2d(ji,jj,35) = fslownflux                !! slow detritus flux at  500 m 
    2962                   if (jk.eq.i1000) trc2d(ji,jj,36) = fslownflux                !! slow detritus flux at 1000 m 
     3958                  if (jk.eq.i0100) trc2d(ji,jj,33) = fslownflux(ji,jj)         !! slow detritus flux at  100 m 
     3959                  if (jk.eq.i0200) trc2d(ji,jj,34) = fslownflux(ji,jj)         !! slow detritus flux at  200 m 
     3960                  if (jk.eq.i0500) trc2d(ji,jj,35) = fslownflux(ji,jj)         !! slow detritus flux at  500 m 
     3961                  if (jk.eq.i1000) trc2d(ji,jj,36) = fslownflux(ji,jj)         !! slow detritus flux at 1000 m 
    29633962                  trc2d(ji,jj,37) = trc2d(ji,jj,37) + fregen                   !! non-fast N  full column regeneration 
    29643963                  trc2d(ji,jj,38) = trc2d(ji,jj,38) + fregensi                 !! non-fast Si full column regeneration 
    … …  
    29943993                  trc2d(ji,jj,68) = trc2d(ji,jj,68) + (freminca * fthk)        !! sum of fast-sinking Ca fluxes 
    29953994                  if (jk.eq.(mbathy(ji,jj)-1)) then 
    2996                      trc2d(ji,jj,69) = fsedn                                   !! N  sedimentation flux                                   
    2997                      trc2d(ji,jj,70) = fsedsi                                  !! Si sedimentation flux 
    2998                      trc2d(ji,jj,71) = fsedfe                                  !! Fe sedimentation flux 
    2999                      trc2d(ji,jj,72) = fsedc                                   !! C  sedimentation flux 
    3000                      trc2d(ji,jj,73) = fsedca                                  !! Ca sedimentation flux 
     3995                     trc2d(ji,jj,69) = fsedn(ji,jj)                                   !! N  sedimentation flux                                   
     3996                     trc2d(ji,jj,70) = fsedsi(ji,jj)                                  !! Si sedimentation flux 
     3997                     trc2d(ji,jj,71) = fsedfe(ji,jj)                                  !! Fe sedimentation flux 
     3998                     trc2d(ji,jj,72) = fsedc(ji,jj)                                   !! C  sedimentation flux 
     3999                     trc2d(ji,jj,73) = fsedca(ji,jj)                                  !! Ca sedimentation flux 
    30014000                  endif 
    30024001                  if (jk.eq.1)  trc2d(ji,jj,74) = qsr(ji,jj) 
    … …  
    30044003                  !! if (jk.eq.1)  trc2d(ji,jj,75) = real(iters) 
    30054004                  !! diagnostic fields 76 to 80 calculated below 
    3006                   trc2d(ji,jj,81) = trc2d(ji,jj,81) + fprn_ml                  !! mixed layer non-diatom production 
    3007                   trc2d(ji,jj,82) = trc2d(ji,jj,82) + fprd_ml                  !! mixed layer     diatom production 
     4005                  trc2d(ji,jj,81) = trc2d(ji,jj,81) + fprn_ml(ji,jj)           !! mixed layer non-diatom production 
     4006                  trc2d(ji,jj,82) = trc2d(ji,jj,82) + fprd_ml(ji,jj)           !! mixed layer     diatom production 
    30084007# if defined key_gulf_finland 
    30094008                  if (jk.eq.1)  trc2d(ji,jj,83) = real(ibio_switch)            !! Gulf of Finland check 
    … …  
    30124011# endif 
    30134012                  trc2d(ji,jj,84) = fccd(ji,jj)                                !! last model level above calcite CCD depth 
    3014                   if (jk.eq.1)     trc2d(ji,jj,85) = xFree                     !! surface "free" iron 
    3015                   if (jk.eq.i0200) trc2d(ji,jj,86) = xFree                     !! "free" iron at  100 m 
    3016                   if (jk.eq.i0200) trc2d(ji,jj,87) = xFree                     !! "free" iron at  200 m 
    3017                   if (jk.eq.i0500) trc2d(ji,jj,88) = xFree                     !! "free" iron at  500 m 
    3018                   if (jk.eq.i1000) trc2d(ji,jj,89) = xFree                     !! "free" iron at 1000 m 
     4013                  if (jk.eq.1)     trc2d(ji,jj,85) = xFree(ji,jj)              !! surface "free" iron 
     4014                  if (jk.eq.i0200) trc2d(ji,jj,86) = xFree(ji,jj)              !! "free" iron at  100 m 
     4015                  if (jk.eq.i0200) trc2d(ji,jj,87) = xFree(ji,jj)              !! "free" iron at  200 m 
     4016                  if (jk.eq.i0500) trc2d(ji,jj,88) = xFree(ji,jj)              !! "free" iron at  500 m 
     4017                  if (jk.eq.i1000) trc2d(ji,jj,89) = xFree(ji,jj)              !! "free" iron at 1000 m 
    30194018                  !! AXY (27/06/12): extract "euphotic depth" 
    30204019                  if (jk.eq.1)     trc2d(ji,jj,90) = xze(ji,jj) 
    30214020                  !!  
    3022                   ftot_pn(ji,jj)  = ftot_pn(ji,jj)  + (zphn * fthk)            !! vertical integral non-diatom phytoplankton 
    3023                   ftot_pd(ji,jj)  = ftot_pd(ji,jj)  + (zphd * fthk)            !! vertical integral diatom phytoplankton 
    3024                   ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk)            !! vertical integral microzooplankton 
    3025                   ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk)            !! vertical integral mesozooplankton 
    3026                   ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk)            !! vertical integral slow detritus, nitrogen 
    3027                   ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk)            !! vertical integral slow detritus, carbon 
    30284021# if defined key_roam 
    30294022                  !! ROAM provisionally has access to a further 20 2D diagnostics 
    … …  
    30774070                  trc2d(ji,jj,140) = trc2d(ji,jj,140) + (f_riv_loc_alk * fthk) 
    30784071                  trc2d(ji,jj,141) = trc2d(ji,jj,141) + (fslowc  * fthk)       !! slow sinking detritus C production 
    3079                   if (jk.eq.i0100) trc2d(ji,jj,142) = fslowcflux               !! slow detritus flux at  100 m 
    3080                   if (jk.eq.i0200) trc2d(ji,jj,143) = fslowcflux               !! slow detritus flux at  200 m 
    3081                   if (jk.eq.i0500) trc2d(ji,jj,144) = fslowcflux               !! slow detritus flux at  500 m 
    3082                   if (jk.eq.i1000) trc2d(ji,jj,145) = fslowcflux               !! slow detritus flux at 1000 m 
    3083                   trc2d(ji,jj,146)  = trc2d(ji,jj,146)  + ftot_c               !! carbon     inventory 
    3084                   trc2d(ji,jj,147)  = trc2d(ji,jj,147)  + ftot_a               !! alkalinity inventory 
    3085                   trc2d(ji,jj,148)  = trc2d(ji,jj,148)  + ftot_o2              !! oxygen     inventory 
     4072                  if (jk.eq.i0100) trc2d(ji,jj,142) = fslowcflux(ji,jj)        !! slow detritus flux at  100 m 
     4073                  if (jk.eq.i0200) trc2d(ji,jj,143) = fslowcflux(ji,jj)        !! slow detritus flux at  200 m 
     4074                  if (jk.eq.i0500) trc2d(ji,jj,144) = fslowcflux(ji,jj)        !! slow detritus flux at  500 m 
     4075                  if (jk.eq.i1000) trc2d(ji,jj,145) = fslowcflux(ji,jj)        !! slow detritus flux at 1000 m 
     4076                  trc2d(ji,jj,146)  = trc2d(ji,jj,146)  + ftot_c(ji,jj)        !! carbon     inventory 
     4077                  trc2d(ji,jj,147)  = trc2d(ji,jj,147)  + ftot_a(ji,jj)        !! alkalinity inventory 
     4078                  trc2d(ji,jj,148)  = trc2d(ji,jj,148)  + ftot_o2(ji,jj)       !! oxygen     inventory 
    30864079                  if (jk.eq.(mbathy(ji,jj)-1)) then 
    30874080                     trc2d(ji,jj,149) = f_benout_lyso_ca(ji,jj) 
    30884081                  endif 
    3089                   trc2d(ji,jj,150) = trc2d(ji,jj,150) + (fcomm_resp * fthk)    !! community respiration 
     4082                  trc2d(ji,jj,150) = fcomm_resp(ji,jj) * fthk                  !! community respiration 
    30904083        !! 
    30914084        !! AXY (14/02/14): a Valentines Day gift to BASIN - a shedload of new 
    … …  
    31514144        !! 
    31524145        !! extract fields at surface 
    3153         if (jk .eq. 1) then 
    3154                      trc2d(ji,jj,172) = zchn              !! Pn chlorophyll 
    3155                      trc2d(ji,jj,173) = zphn              !! Pn biomass 
    3156                      trc2d(ji,jj,174) = fjln              !! Pn J-term 
    3157                      trc2d(ji,jj,175) = (fprn * zphn)     !! Pn PP 
    3158                      trc2d(ji,jj,176) = zchd              !! Pd chlorophyll 
    3159                      trc2d(ji,jj,177) = zphd              !! Pd biomass 
    3160                      trc2d(ji,jj,178) = fjld              !! Pd J-term 
    3161                      trc2d(ji,jj,179) = xpar(ji,jj,jk)    !! Pd PP 
    3162                      trc2d(ji,jj,180) = loc_T             !! local temperature 
    3163                   endif 
    3164         !! 
    3165         !! extract fields at 50m (actually 44-50m) 
    3166         if (jk .eq. 18) then 
    3167                      trc2d(ji,jj,181) = zchn              !! Pn chlorophyll 
    3168                      trc2d(ji,jj,182) = zphn              !! Pn biomass 
    3169                      trc2d(ji,jj,183) = fjln              !! Pn J-term 
    3170                      trc2d(ji,jj,184) = (fprn * zphn)     !! Pn PP 
    3171                      trc2d(ji,jj,185) = zchd              !! Pd chlorophyll 
    3172                      trc2d(ji,jj,186) = zphd              !! Pd biomass 
    3173                      trc2d(ji,jj,187) = fjld              !! Pd J-term 
    3174                      trc2d(ji,jj,188) = xpar(ji,jj,jk)    !! Pd PP 
    3175                      trc2d(ji,jj,189) = loc_T             !! local temperature 
    3176                   endif 
    3177         !! 
    3178         !! extract fields at 100m 
    3179         if (jk .eq. i0100) then 
    3180                      trc2d(ji,jj,190) = zchn              !! Pn chlorophyll 
    3181                      trc2d(ji,jj,191) = zphn              !! Pn biomass 
    3182                      trc2d(ji,jj,192) = fjln              !! Pn J-term 
    3183                      trc2d(ji,jj,193) = (fprn * zphn)     !! Pn PP 
    3184                      trc2d(ji,jj,194) = zchd              !! Pd chlorophyll 
    3185                      trc2d(ji,jj,195) = zphd              !! Pd biomass 
    3186                      trc2d(ji,jj,196) = fjld              !! Pd J-term 
    3187                      trc2d(ji,jj,197) = xpar(ji,jj,jk)    !! Pd PP 
    3188                      trc2d(ji,jj,198) = loc_T             !! local temperature 
    3189                   endif 
     4146       !! if (jk .eq. 1) then 
     4147                 !!    trc2d(ji,jj,172) = zchn              !! Pn chlorophyll 
     4148                 !!    trc2d(ji,jj,173) = zphn              !! Pn biomass 
     4149                 !!    trc2d(ji,jj,174) = fjln              !! Pn J-term 
     4150                 !!    trc2d(ji,jj,175) = (fprn * zphn)     !! Pn PP 
     4151                 !!    trc2d(ji,jj,176) = zchd              !! Pd chlorophyll 
     4152                 !!    trc2d(ji,jj,177) = zphd              !! Pd biomass 
     4153                 !!    trc2d(ji,jj,178) = fjld              !! Pd J-term 
     4154                 !!    trc2d(ji,jj,179) = xpar(ji,jj,jk)    !! Pd PP 
     4155                 !!    trc2d(ji,jj,180) = loc_T             !! local temperature 
     4156                 !! endif 
     4157       !! !! 
     4158       !! !! extract fields at 50m (actually 44-50m) 
     4159       !! if (jk .eq. 18) then 
     4160                 !!    trc2d(ji,jj,181) = zchn              !! Pn chlorophyll 
     4161                 !!    trc2d(ji,jj,182) = zphn              !! Pn biomass 
     4162                 !!    trc2d(ji,jj,183) = fjln              !! Pn J-term 
     4163                 !!    trc2d(ji,jj,184) = (fprn * zphn)     !! Pn PP 
     4164                 !!    trc2d(ji,jj,185) = zchd              !! Pd chlorophyll 
     4165                 !!    trc2d(ji,jj,186) = zphd              !! Pd biomass 
     4166                 !!    trc2d(ji,jj,187) = fjld              !! Pd J-term 
     4167                 !!    trc2d(ji,jj,188) = xpar(ji,jj,jk)    !! Pd PP 
     4168                 !!    trc2d(ji,jj,189) = loc_T             !! local temperature 
     4169                 !! endif 
     4170       !! !! 
     4171       !! !! extract fields at 100m 
     4172       !! if (jk .eq. i0100) then 
     4173                 !!    trc2d(ji,jj,190) = zchn              !! Pn chlorophyll 
     4174                 !!    trc2d(ji,jj,191) = zphn              !! Pn biomass 
     4175                 !!    trc2d(ji,jj,192) = fjln              !! Pn J-term 
     4176                 !!    trc2d(ji,jj,193) = (fprn * zphn)     !! Pn PP 
     4177                 !!    trc2d(ji,jj,194) = zchd              !! Pd chlorophyll 
     4178                 !!    trc2d(ji,jj,195) = zphd              !! Pd biomass 
     4179                 !!    trc2d(ji,jj,196) = fjld              !! Pd J-term 
     4180                 !!    trc2d(ji,jj,197) = xpar(ji,jj,jk)    !! Pd PP 
     4181                 !!    trc2d(ji,jj,198) = loc_T             !! local temperature 
     4182                 !! endif 
     4183                 !! 
    31904184                  !! extract relevant BASIN fields at 150m 
    31914185                  if (jk .eq. i0150) then 
    3192                      !! trc2d(ji,jj,172) = trc2d(ji,jj,4)    !! Pn PP 
    3193                      !! trc2d(ji,jj,173) = trc2d(ji,jj,151)  !! Pn linear loss 
    3194                      !! trc2d(ji,jj,174) = trc2d(ji,jj,5)    !! Pn non-linear loss 
    3195                      !! trc2d(ji,jj,175) = trc2d(ji,jj,11)   !! Pn grazing to Zmi 
    3196                      !! trc2d(ji,jj,176) = trc2d(ji,jj,14)   !! Pn grazing to Zme 
    3197                      !! trc2d(ji,jj,177) = trc2d(ji,jj,6)    !! Pd PP 
    3198                      !! trc2d(ji,jj,178) = trc2d(ji,jj,152)  !! Pd linear loss 
    3199                      !! trc2d(ji,jj,179) = trc2d(ji,jj,7)    !! Pd non-linear loss 
    3200                      !! trc2d(ji,jj,180) = trc2d(ji,jj,15)   !! Pd grazing to Zme 
    3201                      !! trc2d(ji,jj,181) = trc2d(ji,jj,12)   !! Zmi grazing on D 
    3202                      !! trc2d(ji,jj,182) = trc2d(ji,jj,170)  !! Zmi grazing on Dc 
    3203                      !! trc2d(ji,jj,183) = trc2d(ji,jj,155)  !! Zmi messy feeding loss to N 
    3204                      !! trc2d(ji,jj,184) = trc2d(ji,jj,156)  !! Zmi messy feeding loss to D 
    3205                      !! trc2d(ji,jj,185) = trc2d(ji,jj,157)  !! Zmi messy feeding loss to DIC 
    3206                      !! trc2d(ji,jj,186) = trc2d(ji,jj,158)  !! Zmi messy feeding loss to Dc 
    3207                      !! trc2d(ji,jj,187) = trc2d(ji,jj,159)  !! Zmi excretion 
    3208                      !! trc2d(ji,jj,188) = trc2d(ji,jj,160)  !! Zmi respiration 
    3209                      !! trc2d(ji,jj,189) = trc2d(ji,jj,161)  !! Zmi growth 
    3210                      !! trc2d(ji,jj,190) = trc2d(ji,jj,153)  !! Zmi linear loss 
    3211                      !! trc2d(ji,jj,191) = trc2d(ji,jj,13)   !! Zmi non-linear loss 
    3212                      !! trc2d(ji,jj,192) = trc2d(ji,jj,16)   !! Zmi grazing to Zme 
    3213                      !! trc2d(ji,jj,193) = trc2d(ji,jj,17)   !! Zme grazing on D 
    3214                      !! trc2d(ji,jj,194) = trc2d(ji,jj,171)  !! Zme grazing on Dc 
    3215                      !! trc2d(ji,jj,195) = trc2d(ji,jj,162)  !! Zme messy feeding loss to N 
    3216                      !! trc2d(ji,jj,196) = trc2d(ji,jj,163)  !! Zme messy feeding loss to D 
    3217                      !! trc2d(ji,jj,197) = trc2d(ji,jj,164)  !! Zme messy feeding loss to DIC 
    3218                      !! trc2d(ji,jj,198) = trc2d(ji,jj,165)  !! Zme messy feeding loss to Dc 
     4186                     trc2d(ji,jj,172) = trc2d(ji,jj,4)    !! Pn PP 
     4187                     trc2d(ji,jj,173) = trc2d(ji,jj,151)  !! Pn linear loss 
     4188                     trc2d(ji,jj,174) = trc2d(ji,jj,5)    !! Pn non-linear loss 
     4189                     trc2d(ji,jj,175) = trc2d(ji,jj,11)   !! Pn grazing to Zmi 
     4190                     trc2d(ji,jj,176) = trc2d(ji,jj,14)   !! Pn grazing to Zme 
     4191                     trc2d(ji,jj,177) = trc2d(ji,jj,6)    !! Pd PP 
     4192                     trc2d(ji,jj,178) = trc2d(ji,jj,152)  !! Pd linear loss 
     4193                     trc2d(ji,jj,179) = trc2d(ji,jj,7)    !! Pd non-linear loss 
     4194                     trc2d(ji,jj,180) = trc2d(ji,jj,15)   !! Pd grazing to Zme 
     4195                     trc2d(ji,jj,181) = trc2d(ji,jj,12)   !! Zmi grazing on D 
     4196                     trc2d(ji,jj,182) = trc2d(ji,jj,170)  !! Zmi grazing on Dc 
     4197                     trc2d(ji,jj,183) = trc2d(ji,jj,155)  !! Zmi messy feeding loss to N 
     4198                     trc2d(ji,jj,184) = trc2d(ji,jj,156)  !! Zmi messy feeding loss to D 
     4199                     trc2d(ji,jj,185) = trc2d(ji,jj,157)  !! Zmi messy feeding loss to DIC 
     4200                     trc2d(ji,jj,186) = trc2d(ji,jj,158)  !! Zmi messy feeding loss to Dc 
     4201                     trc2d(ji,jj,187) = trc2d(ji,jj,159)  !! Zmi excretion 
     4202                     trc2d(ji,jj,188) = trc2d(ji,jj,160)  !! Zmi respiration 
     4203                     trc2d(ji,jj,189) = trc2d(ji,jj,161)  !! Zmi growth 
     4204                     trc2d(ji,jj,190) = trc2d(ji,jj,153)  !! Zmi linear loss 
     4205                     trc2d(ji,jj,191) = trc2d(ji,jj,13)   !! Zmi non-linear loss 
     4206                     trc2d(ji,jj,192) = trc2d(ji,jj,16)   !! Zmi grazing to Zme 
     4207                     trc2d(ji,jj,193) = trc2d(ji,jj,17)   !! Zme grazing on D 
     4208                     trc2d(ji,jj,194) = trc2d(ji,jj,171)  !! Zme grazing on Dc 
     4209                     trc2d(ji,jj,195) = trc2d(ji,jj,162)  !! Zme messy feeding loss to N 
     4210                     trc2d(ji,jj,196) = trc2d(ji,jj,163)  !! Zme messy feeding loss to D 
     4211                     trc2d(ji,jj,197) = trc2d(ji,jj,164)  !! Zme messy feeding loss to DIC 
     4212                     trc2d(ji,jj,198) = trc2d(ji,jj,165)  !! Zme messy feeding loss to Dc 
    32194213                     trc2d(ji,jj,199) = trc2d(ji,jj,166)  !! Zme excretion 
    32204214                     trc2d(ji,jj,200) = trc2d(ji,jj,167)  !! Zme respiration 
    … …  
    32314225                     trc2d(ji,jj,211) = trc2d(ji,jj,67)   !! Fast detritus remineralisation, C 
    32324226                     trc2d(ji,jj,212) = trc2d(ji,jj,150)  !! Community respiration 
    3233                      trc2d(ji,jj,213) = fslownflux        !! Slow detritus N flux at 150 m 
    3234                      trc2d(ji,jj,214) = fslowcflux        !! Slow detritus C flux at 150 m 
     4227                     trc2d(ji,jj,213) = fslownflux(ji,jj) !! Slow detritus N flux at 150 m 
     4228                     trc2d(ji,jj,214) = fslowcflux(ji,jj) !! Slow detritus C flux at 150 m 
    32354229                     trc2d(ji,jj,215) = ffastn(ji,jj)     !! Fast detritus N flux at 150 m 
    32364230                     trc2d(ji,jj,216) = ffastc(ji,jj)     !! Fast detritus C flux at 150 m 
    … …  
    32604254                  !! 
    32614255                  trc3d(ji,jj,jk,1)  = ((fprn + fprd) * zphn)     !! primary production   
    3262                   trc3d(ji,jj,jk,2)  = fslownflux + ffastn(ji,jj) !! detrital flux 
     4256                  trc3d(ji,jj,jk,2)  = fslownflux(ji,jj) + ffastn(ji,jj) !! detrital flux 
    32634257                  trc3d(ji,jj,jk,3)  = fregen + (freminn * fthk)  !! remineralisation 
    32644258# if defined key_roam 
    … …  
    32724266            endif 
    32734267         !! CLOSE horizontal loops 
    3274          END DO 
    3275          END DO 
     4268         ENDDO 
     4269         ENDDO 
     4270         !! 
     4271             IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
     4272                 !! first - 2D diag implemented  
     4273                 !!         on every K level 
     4274                 !!----------------------------------------- 
     4275                 !!  -- 
     4276                 !!second - 2d specific k level diags 
     4277                 !! 
     4278                 !!----------------------------------------- 
     4279                 IF (jk.eq.1) THEN 
     4280#   if defined key_debug_medusa 
     4281                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1' 
     4282                     CALL flush(numout) 
     4283#   endif 
     4284                     IF( med_diag%MED_QSR%dgsave ) THEN 
     4285                         CALL iom_put( "MED_QSR"  , qsr ) ! 
     4286                     ENDIF 
     4287                     IF( med_diag%MED_XPAR%dgsave ) THEN 
     4288                         CALL iom_put( "MED_XPAR"  , xpar(:,:,jk) ) ! 
     4289                     ENDIF        
     4290                     IF( med_diag%OCAL_CCD%dgsave ) THEN 
     4291                         CALL iom_put( "OCAL_CCD"  , ocal_ccd ) ! 
     4292                     ENDIF 
     4293                     IF( med_diag%FE_0000%dgsave ) THEN 
     4294                         CALL iom_put( "FE_0000"  , xFree ) ! 
     4295                     ENDIF                      
     4296                     IF( med_diag%MED_XZE%dgsave ) THEN 
     4297                         CALL iom_put( "MED_XZE"  , xze ) ! 
     4298                     ENDIF  
     4299# if defined key_roam                      
     4300                     IF( med_diag%WIND%dgsave ) THEN 
     4301                         CALL iom_put( "WIND"  , wndm ) 
     4302                     ENDIF 
     4303                     IF( med_diag%ATM_PCO2%dgsave ) THEN 
     4304                         CALL iom_put( "ATM_PCO2"  , f_pco2a2d ) 
     4305                         CALL wrk_dealloc( jpi, jpj,    f_pco2a2d  ) 
     4306                     ENDIF 
     4307                     IF( med_diag%OCN_PH%dgsave ) THEN 
     4308                         zw2d(:,:) = f3_pH(:,:,jk) 
     4309                         CALL iom_put( "OCN_PH"  , zw2d ) 
     4310                     ENDIF 
     4311                     IF( med_diag%OCN_PCO2%dgsave ) THEN 
     4312                         CALL iom_put( "OCN_PCO2"  , f_pco2w2d ) 
     4313                          CALL wrk_dealloc( jpi, jpj,   f_pco2w2d   ) 
     4314                     ENDIF 
     4315                     IF( med_diag%OCNH2CO3%dgsave ) THEN 
     4316                         zw2d(:,:) = f3_h2co3(:,:,jk) 
     4317                         CALL iom_put( "OCNH2CO3"  , zw2d ) 
     4318                     ENDIF 
     4319                     IF( med_diag%OCN_HCO3%dgsave ) THEN 
     4320                         zw2d(:,:) = f3_hco3(:,:,jk) 
     4321                         CALL iom_put( "OCN_HCO3"  , zw2d ) 
     4322                     ENDIF 
     4323                     IF( med_diag%OCN_CO3%dgsave ) THEN 
     4324                         zw2d(:,:) = f3_co3(:,:,jk) 
     4325                         CALL iom_put( "OCN_CO3"  , zw2d ) 
     4326                     ENDIF 
     4327                     IF( med_diag%CO2FLUX%dgsave ) THEN 
     4328                         CALL iom_put( "CO2FLUX"  , f_co2flux2d ) 
     4329                          CALL wrk_dealloc( jpi, jpj,   f_co2flux2d   ) 
     4330                     ENDIF 
     4331                     IF( med_diag%OM_CAL%dgsave ) THEN 
     4332                         CALL iom_put( "OM_CAL"  , f_omcal ) 
     4333                     ENDIF 
     4334                     IF( med_diag%OM_ARG%dgsave ) THEN 
     4335                         CALL iom_put( "OM_ARG"  , f_omarg ) 
     4336                     ENDIF 
     4337                     IF( med_diag%TCO2%dgsave ) THEN 
     4338                         CALL iom_put( "TCO2"  , f_TDIC2d ) 
     4339                          CALL wrk_dealloc( jpi, jpj,   f_TDIC2d   ) 
     4340                     ENDIF 
     4341                     IF( med_diag%TALK%dgsave ) THEN 
     4342                         CALL iom_put( "TALK"  , f_TALK2d ) 
     4343                          CALL wrk_dealloc( jpi, jpj,    f_TALK2d  ) 
     4344                     ENDIF 
     4345                     IF( med_diag%KW660%dgsave ) THEN 
     4346                         CALL iom_put( "KW660"  , f_kw6602d ) 
     4347                          CALL wrk_dealloc( jpi, jpj,   f_kw6602d   ) 
     4348                     ENDIF 
     4349                     IF( med_diag%ATM_PP0%dgsave ) THEN 
     4350                         CALL iom_put( "ATM_PP0"  , f_pp02d ) 
     4351                          CALL wrk_dealloc( jpi, jpj,    f_pp02d  ) 
     4352                     ENDIF 
     4353                     IF( med_diag%O2FLUX%dgsave ) THEN 
     4354                         CALL iom_put( "O2FLUX"  , f_o2flux2d ) 
     4355                          CALL wrk_dealloc( jpi, jpj,   f_o2flux2d   ) 
     4356                     ENDIF 
     4357                     IF( med_diag%O2SAT%dgsave ) THEN 
     4358                         CALL iom_put( "O2SAT"  , f_o2sat2d ) 
     4359                          CALL wrk_dealloc( jpi, jpj,  f_o2sat2d    ) 
     4360                     ENDIF 
     4361                     IF( med_diag%CAL_CCD%dgsave ) THEN 
     4362                         CALL iom_put( "CAL_CCD"  , f2_ccd_cal ) 
     4363                     ENDIF 
     4364                     IF( med_diag%ARG_CCD%dgsave ) THEN 
     4365                         CALL iom_put( "ARG_CCD"  , f2_ccd_arg ) 
     4366                     ENDIF 
     4367                     IF (jdms .eq. 1) THEN 
     4368                       IF( med_diag%DMS_SURF%dgsave ) THEN 
     4369                         CALL iom_put( "DMS_SURF"  , dms_surf2d ) 
     4370                          CALL wrk_dealloc( jpi, jpj,   dms_surf2d   ) 
     4371                       ENDIF 
     4372                       IF( med_diag%DMS_ANDR%dgsave ) THEN 
     4373                         CALL iom_put( "DMS_ANDR"  , dms_andr2d ) 
     4374                          CALL wrk_dealloc( jpi, jpj,   dms_andr2d   ) 
     4375                       ENDIF 
     4376                       IF( med_diag%DMS_SIMO%dgsave ) THEN 
     4377                         CALL iom_put( "DMS_SIMO"  , dms_simo2d ) 
     4378                          CALL wrk_dealloc( jpi, jpj,    dms_simo2d  ) 
     4379                       ENDIF 
     4380                       IF( med_diag%DMS_ARAN%dgsave ) THEN 
     4381                         CALL iom_put( "DMS_ARAN"  , dms_aran2d ) 
     4382                          CALL wrk_dealloc( jpi, jpj,   dms_aran2d   ) 
     4383                       ENDIF 
     4384                       IF( med_diag%DMS_HALL%dgsave ) THEN 
     4385                         CALL iom_put( "DMS_HALL"  , dms_hall2d ) 
     4386                          CALL wrk_dealloc( jpi, jpj,   dms_hall2d   ) 
     4387                       ENDIF 
     4388                     ENDIF 
     4389# endif                      
     4390                 ELSE IF (jk.eq.i0100) THEN  
     4391#   if defined key_debug_medusa 
     4392                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 100' 
     4393                     CALL flush(numout) 
     4394#   endif 
     4395                     IF( med_diag%SDT__100%dgsave ) THEN 
     4396                         CALL iom_put( "SDT__100"  , fslownflux ) 
     4397                     ENDIF 
     4398                     IF( med_diag%REG__100%dgsave ) THEN 
     4399                         CALL iom_put( "REG__100"  , fregen2d ) 
     4400                     ENDIF 
     4401                     IF( med_diag%FDT__100%dgsave ) THEN 
     4402                         CALL iom_put( "FDT__100"  , ffastn ) 
     4403                     ENDIF            
     4404                     IF( med_diag%RG__100F%dgsave ) THEN 
     4405                         CALL iom_put( "RG__100F"  , fregenfast ) 
     4406                     ENDIF 
     4407                     IF( med_diag%FDS__100%dgsave ) THEN 
     4408                         CALL iom_put( "FDS__100"  , ffastsi ) 
     4409                     ENDIF          
     4410                     IF( med_diag%RGS_100F%dgsave ) THEN 
     4411                         CALL iom_put( "RGS_100F"  , fregenfastsi ) 
     4412                     ENDIF 
     4413                     IF( med_diag%FE_0100%dgsave ) THEN 
     4414                         CALL iom_put( "FE_0100"  , xFree ) 
     4415                     ENDIF 
     4416# if defined key_roam                      
     4417                     IF( med_diag%RR_0100%dgsave ) THEN 
     4418                         CALL iom_put( "RR_0100"  , ffastca2d ) 
     4419                     ENDIF                      
     4420                     IF( med_diag%SDC__100%dgsave ) THEN 
     4421                         CALL iom_put( "SDC__100"  , fslowcflux ) 
     4422                     ENDIF                   
     4423                 ELSE IF (jk.eq.i0150) THEN 
     4424#   if defined key_debug_medusa 
     4425                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 150' 
     4426                     CALL flush(numout) 
     4427#   endif 
     4428                     IF( med_diag%BASIN_01%dgsave ) THEN 
     4429                         CALL iom_put( "BASIN_01"  , fprn2d ) 
     4430                     ENDIF 
     4431                     IF( med_diag%BASIN_02%dgsave ) THEN 
     4432                         CALL iom_put( "BASIN_02"  , fdpn22d ) 
     4433                     ENDIF 
     4434                     IF( med_diag%BASIN_03%dgsave ) THEN 
     4435                         CALL iom_put( "BASIN_03"  , fdpn2d ) 
     4436                     ENDIF 
     4437                     IF( med_diag%BASIN_04%dgsave ) THEN 
     4438                         CALL iom_put( "BASIN_04"  , fgmipn2d ) 
     4439                     ENDIF 
     4440                     IF( med_diag%BASIN_05%dgsave ) THEN 
     4441                         CALL iom_put( "BASIN_05"  , fgmepn2d ) 
     4442                     ENDIF 
     4443                     IF( med_diag%BASIN_06%dgsave ) THEN 
     4444                         CALL iom_put( "BASIN_06"  , fprd2d ) 
     4445                     ENDIF 
     4446                     IF( med_diag%BASIN_07%dgsave ) THEN 
     4447                         CALL iom_put( "BASIN_07"  , fdpd22d ) 
     4448                     ENDIF 
     4449                     IF( med_diag%BASIN_08%dgsave ) THEN 
     4450                         CALL iom_put( "BASIN_08"  , fdpd2d ) 
     4451                     ENDIF 
     4452                     IF( med_diag%BASIN_09%dgsave ) THEN 
     4453                         CALL iom_put( "BASIN_09"  , fgmepd2d ) 
     4454                     ENDIF 
     4455                     IF( med_diag%BASIN_10%dgsave ) THEN 
     4456                         CALL iom_put( "BASIN_10"  , fgmid2d ) 
     4457                     ENDIF 
     4458                     IF( med_diag%BASIN_11%dgsave ) THEN 
     4459                         CALL iom_put( "BASIN_11"  , gmidc2d ) 
     4460                     ENDIF 
     4461                     IF( med_diag%BASIN_12%dgsave ) THEN 
     4462                         CALL iom_put( "BASIN_12"  , zimesn2d ) 
     4463                     ENDIF 
     4464                     IF( med_diag%BASIN_13%dgsave ) THEN 
     4465                         CALL iom_put( "BASIN_13"  , zimesd2d ) 
     4466                     ENDIF 
     4467                     IF( med_diag%BASIN_14%dgsave ) THEN 
     4468                         CALL iom_put( "BASIN_14"  , zimesc2d ) 
     4469                     ENDIF 
     4470                     IF( med_diag%BASIN_15%dgsave ) THEN 
     4471                         CALL iom_put( "BASIN_15"  , zimesdc2d ) 
     4472                     ENDIF 
     4473                     IF( med_diag%BASIN_16%dgsave ) THEN 
     4474                         CALL iom_put( "BASIN_16"  , ziexcr2d ) 
     4475                     ENDIF 
     4476                     IF( med_diag%BASIN_17%dgsave ) THEN 
     4477                         CALL iom_put( "BASIN_17"  , ziresp2d ) 
     4478                     ENDIF 
     4479                     IF( med_diag%BASIN_18%dgsave ) THEN 
     4480                         CALL iom_put( "BASIN_18"  , zigrow2d ) 
     4481                     ENDIF 
     4482                     IF( med_diag%BASIN_19%dgsave ) THEN 
     4483                         CALL iom_put( "BASIN_19"  , fdzmi22d ) 
     4484                     ENDIF 
     4485                     IF( med_diag%BASIN_20%dgsave ) THEN 
     4486                         CALL iom_put( "BASIN_20"  , fdzmi2d ) 
     4487                     ENDIF 
     4488                     IF( med_diag%BASIN_21%dgsave ) THEN 
     4489                         CALL iom_put( "BASIN_21"  , fgmezmi2d ) 
     4490                     ENDIF 
     4491                     IF( med_diag%BASIN_22%dgsave ) THEN 
     4492                         CALL iom_put( "BASIN_22"  , fgmed2d ) 
     4493                     ENDIF 
     4494                     IF( med_diag%BASIN_23%dgsave ) THEN 
     4495                         CALL iom_put( "BASIN_23"  , gmedc2d ) 
     4496                     ENDIF 
     4497                     IF( med_diag%BASIN_24%dgsave ) THEN 
     4498                         CALL iom_put( "BASIN_24"  , zemesn2d ) 
     4499                     ENDIF   
     4500                     IF( med_diag%BASIN_25%dgsave ) THEN 
     4501                         CALL iom_put( "BASIN_25"  , zemesd2d ) 
     4502                     ENDIF 
     4503                     IF( med_diag%BASIN_26%dgsave ) THEN 
     4504                         CALL iom_put( "BASIN_26"  , zemesc2d ) 
     4505                     ENDIF 
     4506                     IF( med_diag%BASIN_27%dgsave ) THEN 
     4507                         CALL iom_put( "BASIN_27"  , zemesdc2d ) 
     4508                     ENDIF 
     4509                     IF( med_diag%BASIN_28%dgsave ) THEN 
     4510                         CALL iom_put( "BASIN_28"  , zeexcr2d ) 
     4511                     ENDIF 
     4512                     IF( med_diag%BASIN_29%dgsave ) THEN 
     4513                         CALL iom_put( "BASIN_29"  , zeresp2d ) 
     4514                     ENDIF 
     4515                     IF( med_diag%BASIN_30%dgsave ) THEN 
     4516                         CALL iom_put( "BASIN_30"  , zegrow2d ) 
     4517                     ENDIF 
     4518                     IF( med_diag%BASIN_31%dgsave ) THEN 
     4519                         CALL iom_put( "BASIN_30"  , fdzme22d ) 
     4520                     ENDIF 
     4521                     IF( med_diag%BASIN_32%dgsave ) THEN 
     4522                         CALL iom_put( "BASIN_32"  , fdzme2d ) 
     4523                     ENDIF 
     4524                     IF( med_diag%BASIN_33%dgsave ) THEN 
     4525                         CALL iom_put( "BASIN_33"  , fslown2d ) 
     4526                     ENDIF 
     4527                     IF( med_diag%BASIN_34%dgsave ) THEN 
     4528                         CALL iom_put( "BASIN_34"  , fdd2d ) 
     4529                     ENDIF 
     4530                     IF( med_diag%BASIN_35%dgsave ) THEN 
     4531                         CALL iom_put( "BASIN_35"  , fslowc2d ) 
     4532                     ENDIF 
     4533                     IF( med_diag%BASIN_36%dgsave ) THEN 
     4534                         CALL iom_put( "BASIN_36"  , mdetc2d ) 
     4535                     ENDIF 
     4536                     IF( med_diag%BASIN_37%dgsave ) THEN 
     4537                         CALL iom_put( "BASIN_37"  , ftempn2d ) 
     4538                     ENDIF 
     4539                     IF( med_diag%BASIN_38%dgsave ) THEN 
     4540                         CALL iom_put( "BASIN_38"  , freminn2d ) 
     4541                     ENDIF 
     4542                     IF( med_diag%BASIN_39%dgsave ) THEN 
     4543                         CALL iom_put( "BASIN_39"  , ftempc2d ) 
     4544                     ENDIF 
     4545                     IF( med_diag%BASIN_40%dgsave ) THEN 
     4546                         CALL iom_put( "BASIN_40"  , freminc2d ) 
     4547                     ENDIF 
     4548                     IF( med_diag%BASIN_41%dgsave ) THEN 
     4549                         CALL iom_put( "BASIN_41"  , fcomm_resp ) 
     4550                     ENDIF                   
     4551                     IF( med_diag%BASIN_42%dgsave ) THEN 
     4552                         CALL iom_put( "BASIN_42"  , fslownflux ) 
     4553                     ENDIF 
     4554                     IF( med_diag%BASIN_43%dgsave ) THEN 
     4555                         CALL iom_put( "BASIN_43"  , fslowcflux ) 
     4556                     ENDIF 
     4557                     IF( med_diag%BASIN_44%dgsave ) THEN 
     4558                         CALL iom_put( "BASIN_44"  , ffastn ) 
     4559                     ENDIF 
     4560                     IF( med_diag%BASIN_45%dgsave ) THEN 
     4561                         CALL iom_put( "BASIN_45"  , ffastc ) 
     4562                     ENDIF 
     4563# endif                      
     4564                 ELSE IF (jk.eq.i0200) THEN 
     4565#   if defined key_debug_medusa 
     4566                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 200' 
     4567                     CALL flush(numout) 
     4568#   endif 
     4569                     IF( med_diag%SDT__200%dgsave ) THEN 
     4570                         CALL iom_put( "SDT__200"  , fslownflux ) 
     4571                     ENDIF 
     4572                     IF( med_diag%REG__200%dgsave ) THEN 
     4573                         CALL iom_put( "REG__200"  , fregen2d ) 
     4574                     ENDIF 
     4575                     IF( med_diag%FDT__200%dgsave ) THEN 
     4576                         CALL iom_put( "FDT__200"  , ffastn ) 
     4577                     ENDIF 
     4578                     IF( med_diag%RG__200F%dgsave ) THEN 
     4579                         CALL iom_put( "RG__200F"  , fregenfast ) 
     4580                     ENDIF 
     4581                     IF( med_diag%FDS__200%dgsave ) THEN 
     4582                         CALL iom_put( "FDS__200"  , ffastsi ) 
     4583                     ENDIF 
     4584                     IF( med_diag%RGS_200F%dgsave ) THEN 
     4585                         CALL iom_put( "RGS_200F"  , fregenfastsi ) 
     4586                     ENDIF 
     4587                     IF( med_diag%FE_0200%dgsave ) THEN 
     4588                         CALL iom_put( "FE_0200"  , xFree ) 
     4589                     ENDIF 
     4590# if defined key_roam                      
     4591                     IF( med_diag%SDC__200%dgsave ) THEN 
     4592                         CALL iom_put( "SDC__200"  , fslowcflux ) 
     4593                     ENDIF 
     4594# endif                      
     4595                 ELSE IF (jk.eq.i0500) THEN 
     4596#   if defined key_debug_medusa 
     4597                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 500' 
     4598                     CALL flush(numout) 
     4599#   endif 
     4600                     IF( med_diag%SDT__500%dgsave ) THEN 
     4601                         CALL iom_put( "SDT__500"  , fregen2d ) 
     4602                     ENDIF 
     4603                     IF( med_diag%REG__500%dgsave ) THEN 
     4604                         CALL iom_put( "REG__500"  , fregen2d ) 
     4605                     ENDIF       
     4606                     IF( med_diag%FDT__500%dgsave ) THEN 
     4607                         CALL iom_put( "FDT__500"  , ffastn ) 
     4608                     ENDIF 
     4609                     IF( med_diag%RG__500F%dgsave ) THEN 
     4610                         CALL iom_put( "RG__500F"  , fregenfast ) 
     4611                     ENDIF 
     4612                     IF( med_diag%FDS__500%dgsave ) THEN 
     4613                         CALL iom_put( "FDS__500"  , ffastsi ) 
     4614                     ENDIF 
     4615                     IF( med_diag%RGS_500F%dgsave ) THEN 
     4616                         CALL iom_put( "RGS_500F"  , fregenfastsi ) 
     4617                     ENDIF 
     4618                     IF( med_diag%FE_0500%dgsave ) THEN 
     4619                         CALL iom_put( "FE_0500"  , xFree ) 
     4620                     ENDIF 
     4621# if defined key_roam                      
     4622                     IF( med_diag%RR_0500%dgsave ) THEN 
     4623                         CALL iom_put( "RR_0500"  , ffastca2d ) 
     4624                     ENDIF 
     4625                     IF( med_diag%SDC__500%dgsave ) THEN 
     4626                         CALL iom_put( "SDC__500"  , fslowcflux ) 
     4627                     ENDIF   
     4628# endif                       
     4629                 ELSE IF (jk.eq.i1000) THEN 
     4630#   if defined key_debug_medusa 
     4631                     IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1000' 
     4632                     CALL flush(numout) 
     4633#   endif 
     4634                     IF( med_diag%SDT_1000%dgsave ) THEN 
     4635                         CALL iom_put( "SDT_1000"  , fslownflux ) 
     4636                     ENDIF 
     4637                     IF( med_diag%REG_1000%dgsave ) THEN 
     4638                         CALL iom_put( "REG_1000"  , fregen2d ) 
     4639                     ENDIF   
     4640                     IF( med_diag%FDT_1000%dgsave ) THEN 
     4641                         CALL iom_put( "FDT_1000"  , ffastn ) 
     4642                     ENDIF 
     4643                     IF( med_diag%RG_1000F%dgsave ) THEN 
     4644                         CALL iom_put( "RG_1000F"  , fregenfast ) 
     4645                     ENDIF 
     4646                     IF( med_diag%FDS_1000%dgsave ) THEN 
     4647                         CALL iom_put( "FDS_1000"  , ffastsi ) 
     4648                     ENDIF 
     4649                     IF( med_diag%RGS1000F%dgsave ) THEN 
     4650                         CALL iom_put( "RGS1000F"  , fregenfastsi ) 
     4651                     ENDIF 
     4652                     IF( med_diag%FE_1000%dgsave ) THEN 
     4653                         CALL iom_put( "FE_1000"  , xFree ) 
     4654                     ENDIF 
     4655# if defined key_roam                      
     4656                     IF( med_diag%RR_1000%dgsave ) THEN 
     4657                         CALL iom_put( "RR_1000"  , ffastca2d ) 
     4658                          CALL wrk_dealloc( jpi, jpj,  ffastca2d    ) 
     4659                     ENDIF 
     4660                     IF( med_diag%SDC_1000%dgsave ) THEN 
     4661                         CALL iom_put( "SDC_1000"  , fslowcflux ) 
     4662                     ENDIF  
     4663# endif                       
     4664                 ENDIF 
     4665                 !! to do on every k loop : 
     4666                 IF( med_diag%DETFLUX3%dgsave ) THEN 
     4667                      detflux3d(:,:,jk) = fslownflux(:,:) + ffastn(:,:) !! detrital flux 
     4668                      !CALL iom_put( "DETFLUX3"  , ftot_n ) 
     4669                 ENDIF 
     4670             ENDIF 
    32764671      !! CLOSE vertical loop 
    3277       END DO 
     4672      ENDDO 
    32784673 
    32794674      !!---------------------------------------------------------------------- 
    … …  
    33084703         zn_sed_ca(:,:) = za_sed_ca(:,:) 
    33094704      endif 
    3310       DO jj = 2,jpjm1 
    3311          DO ji = 2,jpim1 
    3312             trc2d(ji,jj,131) = za_sed_n(ji,jj) 
    3313             trc2d(ji,jj,132) = za_sed_fe(ji,jj) 
    3314             trc2d(ji,jj,133) = za_sed_c(ji,jj) 
    3315             trc2d(ji,jj,134) = za_sed_si(ji,jj) 
    3316             trc2d(ji,jj,135) = za_sed_ca(ji,jj) 
     4705      IF( ln_diatrc ) THEN 
     4706         DO jj = 2,jpjm1 
     4707            DO ji = 2,jpim1 
     4708               trc2d(ji,jj,131) = za_sed_n(ji,jj) 
     4709               trc2d(ji,jj,132) = za_sed_fe(ji,jj) 
     4710               trc2d(ji,jj,133) = za_sed_c(ji,jj) 
     4711               trc2d(ji,jj,134) = za_sed_si(ji,jj) 
     4712               trc2d(ji,jj,135) = za_sed_ca(ji,jj) 
     4713            ENDDO 
    33174714         ENDDO 
    3318       ENDDO 
    3319  
     4715         !! AXY (07/07/15): temporary hijacking 
     4716# if defined key_roam 
     4717  !!       trc2d(:,:,126) = zn_dms_chn(:,:) 
     4718  !!       trc2d(:,:,127) = zn_dms_chd(:,:) 
     4719  !!       trc2d(:,:,128) = zn_dms_mld(:,:) 
     4720  !!       trc2d(:,:,129) = zn_dms_qsr(:,:) 
     4721  !!       trc2d(:,:,130) = zn_dms_din(:,:) 
     4722# endif 
     4723      ENDIF  
     4724      !! 
    33204725      if (ibenthic.eq.2) then 
    33214726         !! The code below (in this if ... then ... endif loop) is 
    33224727         !! effectively commented out because it does not work as  
    33234728         !! anticipated; it can be deleted at a later date 
    3324       if (jorgben.eq.1) then 
    3325          za_sed_n(:,:)  = ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ) * rdt 
    3326          za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * rdt 
    3327          za_sed_c(:,:)  = ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ) * rdt 
    3328       endif 
    3329       if (jinorgben.eq.1) then 
    3330          za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt 
    3331          za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt 
    3332       endif 
    3333       !! 
    3334       !! Leap-frog scheme - only in explicit case, otherwise the time stepping 
    3335       !! is already being done in trczdf 
    3336       !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 
    3337       !!    zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 
    3338       !!    IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc) 
    3339       !!    if (jorgben.eq.1) then 
    3340       !!       za_sed_n(:,:)  = zb_sed_n(:,:)  + ( zfact * za_sed_n(:,:)  ) 
    3341       !!      za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) ) 
    3342       !!       za_sed_c(:,:)  = zb_sed_c(:,:)  + ( zfact * za_sed_c(:,:)  ) 
    3343       !!    endif 
    3344       !!    if (jinorgben.eq.1) then 
    3345       !!       za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) ) 
    3346       !!       za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) ) 
    3347       !!    endif 
    3348       !! ENDIF 
    3349       !!  
    3350       !! Time filter and swap of arrays 
    3351       IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         ! centred or tvd scheme 
    3352          IF( neuler == 0 .AND. kt == nittrc000 ) THEN 
     4729         if (jorgben.eq.1) then 
     4730            za_sed_n(:,:)  = ( f_sbenin_n(:,:)  + f_fbenin_n(:,:)  - f_benout_n(:,:)  ) * rdt 
     4731            za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * rdt 
     4732            za_sed_c(:,:)  = ( f_sbenin_c(:,:)  + f_fbenin_c(:,:)  - f_benout_c(:,:)  ) * rdt 
     4733         endif 
     4734         if (jinorgben.eq.1) then 
     4735            za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt 
     4736            za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt 
     4737         endif 
     4738         !! 
     4739         !! Leap-frog scheme - only in explicit case, otherwise the time stepping 
     4740         !! is already being done in trczdf 
     4741         !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 
     4742         !!    zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 
     4743         !!    IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc) 
     4744         !!    if (jorgben.eq.1) then 
     4745         !!       za_sed_n(:,:)  = zb_sed_n(:,:)  + ( zfact * za_sed_n(:,:)  ) 
     4746         !!      za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) ) 
     4747         !!       za_sed_c(:,:)  = zb_sed_c(:,:)  + ( zfact * za_sed_c(:,:)  ) 
     4748         !!    endif 
     4749         !!    if (jinorgben.eq.1) then 
     4750         !!       za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) ) 
     4751         !!       za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) ) 
     4752         !!    endif 
     4753         !! ENDIF 
     4754         !!  
     4755         !! Time filter and swap of arrays 
     4756         IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN ! centred or tvd scheme 
     4757            IF( neuler == 0 .AND. kt == nittrc000 ) THEN 
     4758               if (jorgben.eq.1) then 
     4759                  zb_sed_n(:,:)  = zn_sed_n(:,:) 
     4760                  zn_sed_n(:,:)  = za_sed_n(:,:) 
     4761                  za_sed_n(:,:)  = 0.0 
     4762                  !! 
     4763                  zb_sed_fe(:,:) = zn_sed_fe(:,:) 
     4764                  zn_sed_fe(:,:) = za_sed_fe(:,:) 
     4765                  za_sed_fe(:,:) = 0.0 
     4766                  !! 
     4767                  zb_sed_c(:,:)  = zn_sed_c(:,:) 
     4768                  zn_sed_c(:,:)  = za_sed_c(:,:) 
     4769                  za_sed_c(:,:)  = 0.0 
     4770               endif 
     4771               if (jinorgben.eq.1) then 
     4772                  zb_sed_si(:,:) = zn_sed_si(:,:) 
     4773                  zn_sed_si(:,:) = za_sed_si(:,:) 
     4774                  za_sed_si(:,:) = 0.0 
     4775                  !! 
     4776                  zb_sed_ca(:,:) = zn_sed_ca(:,:) 
     4777                  zn_sed_ca(:,:) = za_sed_ca(:,:) 
     4778                  za_sed_ca(:,:) = 0.0 
     4779               endif 
     4780            ELSE 
     4781               if (jorgben.eq.1) then 
     4782                  zb_sed_n(:,:)  = (atfp  * ( zb_sed_n(:,:)  + za_sed_n(:,:)  )) + (atfp1 * zn_sed_n(:,:) ) 
     4783                  zn_sed_n(:,:)  = za_sed_n(:,:) 
     4784                  za_sed_n(:,:)  = 0.0 
     4785                  !! 
     4786                  zb_sed_fe(:,:) = (atfp  * ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + (atfp1 * zn_sed_fe(:,:)) 
     4787                  zn_sed_fe(:,:) = za_sed_fe(:,:) 
     4788                  za_sed_fe(:,:) = 0.0 
     4789                  !! 
     4790                  zb_sed_c(:,:)  = (atfp  * ( zb_sed_c(:,:)  + za_sed_c(:,:)  )) + (atfp1 * zn_sed_c(:,:) ) 
     4791                  zn_sed_c(:,:)  = za_sed_c(:,:) 
     4792                  za_sed_c(:,:)  = 0.0 
     4793               endif 
     4794               if (jinorgben.eq.1) then 
     4795                  zb_sed_si(:,:) = (atfp  * ( zb_sed_si(:,:) + za_sed_si(:,:) )) + (atfp1 * zn_sed_si(:,:)) 
     4796                  zn_sed_si(:,:) = za_sed_si(:,:) 
     4797                  za_sed_si(:,:) = 0.0 
     4798                  !! 
     4799                  zb_sed_ca(:,:) = (atfp  * ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + (atfp1 * zn_sed_ca(:,:)) 
     4800                  zn_sed_ca(:,:) = za_sed_ca(:,:) 
     4801                  za_sed_ca(:,:) = 0.0 
     4802               endif 
     4803            ENDIF 
     4804         ELSE                   !  case of smolar scheme or muscl 
    33534805            if (jorgben.eq.1) then 
    3354                zb_sed_n(:,:)  = zn_sed_n(:,:) 
     4806               zb_sed_n(:,:)  = za_sed_n(:,:) 
    33554807               zn_sed_n(:,:)  = za_sed_n(:,:) 
    33564808               za_sed_n(:,:)  = 0.0 
    33574809               !! 
    3358                zb_sed_fe(:,:) = zn_sed_fe(:,:) 
     4810               zb_sed_fe(:,:) = za_sed_fe(:,:) 
    33594811               zn_sed_fe(:,:) = za_sed_fe(:,:) 
    33604812               za_sed_fe(:,:) = 0.0 
    33614813               !! 
    3362                zb_sed_c(:,:)  = zn_sed_c(:,:) 
     4814               zb_sed_c(:,:)  = za_sed_c(:,:) 
    33634815               zn_sed_c(:,:)  = za_sed_c(:,:) 
    33644816               za_sed_c(:,:)  = 0.0 
    33654817            endif 
    33664818            if (jinorgben.eq.1) then 
    3367                zb_sed_si(:,:) = zn_sed_si(:,:) 
     4819               zb_sed_si(:,:) = za_sed_si(:,:) 
    33684820               zn_sed_si(:,:) = za_sed_si(:,:) 
    33694821               za_sed_si(:,:) = 0.0 
    33704822               !! 
    3371                zb_sed_ca(:,:) = zn_sed_ca(:,:) 
    3372                zn_sed_ca(:,:) = za_sed_ca(:,:) 
    3373                za_sed_ca(:,:) = 0.0 
    3374             endif 
    3375          ELSE 
    3376             if (jorgben.eq.1) then 
    3377                zb_sed_n(:,:)  = (atfp  * ( zb_sed_n(:,:)  + za_sed_n(:,:)  )) + (atfp1 * zn_sed_n(:,:) ) 
    3378                zn_sed_n(:,:)  = za_sed_n(:,:) 
    3379                za_sed_n(:,:)  = 0.0 
    3380                !! 
    3381                zb_sed_fe(:,:) = (atfp  * ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + (atfp1 * zn_sed_fe(:,:)) 
    3382                zn_sed_fe(:,:) = za_sed_fe(:,:) 
    3383                za_sed_fe(:,:) = 0.0 
    3384                !! 
    3385                zb_sed_c(:,:)  = (atfp  * ( zb_sed_c(:,:)  + za_sed_c(:,:)  )) + (atfp1 * zn_sed_c(:,:) ) 
    3386                zn_sed_c(:,:)  = za_sed_c(:,:) 
    3387                za_sed_c(:,:)  = 0.0 
    3388             endif 
    3389             if (jinorgben.eq.1) then 
    3390                zb_sed_si(:,:) = (atfp  * ( zb_sed_si(:,:) + za_sed_si(:,:) )) + (atfp1 * zn_sed_si(:,:)) 
    3391                zn_sed_si(:,:) = za_sed_si(:,:) 
    3392                za_sed_si(:,:) = 0.0 
    3393                !! 
    3394                zb_sed_ca(:,:) = (atfp  * ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + (atfp1 * zn_sed_ca(:,:)) 
     4823               zb_sed_ca(:,:) = za_sed_ca(:,:) 
    33954824               zn_sed_ca(:,:) = za_sed_ca(:,:) 
    33964825               za_sed_ca(:,:) = 0.0 
    33974826            endif 
    33984827         ENDIF 
    3399       ELSE                                                   !  case of smolar scheme or muscl 
    3400          if (jorgben.eq.1) then 
    3401             zb_sed_n(:,:)  = za_sed_n(:,:) 
    3402             zn_sed_n(:,:)  = za_sed_n(:,:) 
    3403             za_sed_n(:,:)  = 0.0 
    3404             !! 
    3405             zb_sed_fe(:,:) = za_sed_fe(:,:) 
    3406             zn_sed_fe(:,:) = za_sed_fe(:,:) 
    3407             za_sed_fe(:,:) = 0.0 
    3408             !! 
    3409             zb_sed_c(:,:)  = za_sed_c(:,:) 
    3410             zn_sed_c(:,:)  = za_sed_c(:,:) 
    3411             za_sed_c(:,:)  = 0.0 
    3412          endif 
    3413          if (jinorgben.eq.1) then 
    3414             zb_sed_si(:,:) = za_sed_si(:,:) 
    3415             zn_sed_si(:,:) = za_sed_si(:,:) 
    3416             za_sed_si(:,:) = 0.0 
    3417             !! 
    3418             zb_sed_ca(:,:) = za_sed_ca(:,:) 
    3419             zn_sed_ca(:,:) = za_sed_ca(:,:) 
    3420             za_sed_ca(:,:) = 0.0 
    3421          endif 
    3422       ENDIF 
    34234828      endif 
    3424  
     4829       
    34254830      IF( ln_diatrc ) THEN 
    34264831         !!---------------------------------------------------------------------- 
    … …  
    34654870               trc2d(ji,jj,117) = foxy_anox(ji,jj)  !! integrated unrealised oxygen consumption 
    34664871# endif 
    3467             END DO 
    3468          END DO 
    3469  
     4872            ENDDO 
     4873         ENDDO 
     4874          
    34704875# if defined key_roam 
    34714876#  if defined key_axy_nancheck 
    … …  
    34884893                        &        ji, jj, jn 
    34894894                     endif 
    3490                   enddo 
    3491                enddo 
     4895                  ENDDO 
     4896               ENDDO 
    34924897          CALL ctl_stop( 'trcbio_medusa, NAN in 2D diagnostic field' ) 
    34934898            endif 
    … …  
    35094914                           &        ji, jj, jk, jn 
    35104915                        endif 
    3511                      enddo 
    3512                   enddo 
    3513                enddo 
     4916                     ENDDO 
     4917                  ENDDO 
     4918               ENDDO 
    35144919          CALL ctl_stop( 'trcbio_medusa, NAN in 3D diagnostic field' ) 
    35154920            endif 
    … …  
    35264931         DO jn=1,jp_medusa_2d 
    35274932             CALL lbc_lnk(trc2d(:,:,jn),'T',1. ) 
    3528          END DO  
     4933         ENDDO  
    35294934 
    35304935         !! Lateral boundary conditions on trc3d 
    35314936         DO jn=1,jp_medusa_3d 
    35324937             CALL lbc_lnk(trc3d(:,:,1,jn),'T',1. ) 
    3533          END DO  
     4938         ENDDO  
     4939 
    35344940 
    35354941# if defined key_axy_nodiag 
    … …  
    35454951# endif 
    35464952 
    3547 # if defined key_iomput 
     4953 
    35484954         !!---------------------------------------------------------------------- 
    35494955         !! Add in XML diagnostics stuff 
    … …  
    35694975!!          CALL iom_put(TRIM(ctrc3d(5)), trc3d(:,:,:,5)) 
    35704976!! #  endif 
    3571 # endif 
    3572       ENDIF ! end of ln_diatrc option 
     4977 
     4978 
     4979      ELSE IF( lk_iomput .AND. .NOT. ln_diatrc ) THEN 
     4980         !!!---------------------------------------------------------------------- 
     4981         !! Add very last diag calculations  
     4982         !!!---------------------------------------------------------------------- 
     4983         DO jj = 2,jpjm1 
     4984            DO ji = 2,jpim1 
     4985                !!          
     4986                IF( med_diag%PN_JLIM%dgsave ) THEN 
     4987                    fjln2d(ji,jj) = fjln2d(ji,jj)  / MAX(ftot_pn(ji,jj), rsmall) 
     4988                ENDIF 
     4989                IF( med_diag%PN_NLIM%dgsave ) THEN 
     4990                    fnln2d(ji,jj) = fnln2d(ji,jj)  / MAX(ftot_pn(ji,jj), rsmall) 
     4991                ENDIF 
     4992                IF( med_diag%PN_FELIM%dgsave ) THEN 
     4993                    ffln2d(ji,jj) = ffln2d(ji,jj)  / MAX(ftot_pn(ji,jj), rsmall) 
     4994                ENDIF 
     4995                IF( med_diag%PD_JLIM%dgsave ) THEN 
     4996                    fjld2d(ji,jj) = fjld2d(ji,jj)  / MAX(ftot_pd(ji,jj), rsmall) 
     4997                ENDIF 
     4998                IF( med_diag%PD_NLIM%dgsave ) THEN 
     4999                    fnld2d(ji,jj) = fnld2d(ji,jj)  / MAX(ftot_pd(ji,jj), rsmall) 
     5000                ENDIF 
     5001                IF( med_diag%PD_FELIM%dgsave ) THEN 
     5002                    ffld2d(ji,jj) = ffld2d(ji,jj)  / MAX(ftot_pd(ji,jj), rsmall) 
     5003                ENDIF 
     5004                IF( med_diag%PD_SILIM%dgsave ) THEN 
     5005                    fsld2d2(ji,jj) = fsld2d2(ji,jj)  / MAX(ftot_pd(ji,jj), rsmall) 
     5006                ENDIF 
     5007                IF( med_diag%PDSILIM2%dgsave ) THEN 
     5008                    fsld2d(ji,jj) = fsld2d(ji,jj)  / MAX(ftot_pd(ji,jj), rsmall) 
     5009                ENDIF 
     5010            ENDDO 
     5011         ENDDO 
     5012         !!---------------------------------------------------------------------- 
     5013         !! Add in XML diagnostics stuff 
     5014         !!---------------------------------------------------------------------- 
     5015         !! 
     5016         !! ** 2D diagnostics 
     5017#   if defined key_debug_medusa 
     5018         IF (lwp) write (numout,*) 'trc_bio_medusa: export all diag.' 
     5019         CALL flush(numout) 
     5020#   endif 
     5021         IF ( med_diag%INVTN%dgsave ) THEN 
     5022             CALL iom_put( "INVTN"  , ftot_n ) 
     5023         ENDIF 
     5024         IF ( med_diag%INVTSI%dgsave ) THEN 
     5025             CALL iom_put( "INVTSI"  , ftot_si ) 
     5026         ENDIF 
     5027         IF ( med_diag%INVTFE%dgsave ) THEN 
     5028             CALL iom_put( "INVTFE"  , ftot_fe ) 
     5029         ENDIF                            
     5030         IF ( med_diag%ML_PRN%dgsave ) THEN 
     5031             CALL iom_put( "ML_PRN"  , fprn_ml ) 
     5032         ENDIF 
     5033         IF ( med_diag%ML_PRD%dgsave ) THEN 
     5034             CALL iom_put( "ML_PRD"  , fprd_ml ) 
     5035         ENDIF 
     5036         IF ( med_diag%OCAL_LVL%dgsave ) THEN 
     5037             CALL iom_put( "OCAL_LVL"  , fccd ) 
     5038         ENDIF 
     5039         IF ( med_diag%PN_JLIM%dgsave ) THEN 
     5040             CALL iom_put( "PN_JLIM"  , fjln2d ) 
     5041             CALL wrk_dealloc( jpi, jpj,   fjln2d   ) 
     5042         ENDIF 
     5043         IF ( med_diag%PN_NLIM%dgsave ) THEN 
     5044             CALL iom_put( "PN_NLIM"  , fnln2d ) 
     5045             CALL wrk_dealloc( jpi, jpj,   fnln2d   ) 
     5046         ENDIF 
     5047         IF ( med_diag%PN_FELIM%dgsave ) THEN 
     5048             CALL iom_put( "PN_FELIM"  , ffln2d ) 
     5049             CALL wrk_dealloc( jpi, jpj,   ffln2d   ) 
     5050         ENDIF 
     5051         IF ( med_diag%PD_JLIM%dgsave ) THEN 
     5052             CALL iom_put( "PD_JLIM"  , fjld2d ) 
     5053             CALL wrk_dealloc( jpi, jpj,  fjld2d    ) 
     5054         ENDIF 
     5055         IF ( med_diag%PD_NLIM%dgsave ) THEN 
     5056             CALL iom_put( "PD_NLIM"  , fnld2d ) 
     5057             CALL wrk_dealloc( jpi, jpj,   fnld2d  ) 
     5058         ENDIF 
     5059         IF ( med_diag%PD_FELIM%dgsave ) THEN 
     5060             CALL iom_put( "PD_FELIM"  , ffld2d ) 
     5061             CALL wrk_dealloc( jpi, jpj,  ffld2d    ) 
     5062         ENDIF 
     5063         IF ( med_diag%PD_SILIM%dgsave ) THEN 
     5064             CALL iom_put( "PD_SILIM"  , fsld2d2 ) 
     5065             CALL wrk_dealloc( jpi, jpj,   fsld2d2   ) 
     5066         ENDIF 
     5067         IF ( med_diag%PDSILIM2%dgsave ) THEN 
     5068             CALL iom_put( "PDSILIM2"  , fsld2d ) 
     5069             CALL wrk_dealloc( jpi, jpj,   fsld2d   ) 
     5070         ENDIF 
     5071         IF ( med_diag%INTFLX_N%dgsave ) THEN 
     5072             CALL iom_put( "INTFLX_N"  , fflx_n ) 
     5073         ENDIF 
     5074         IF ( med_diag%INTFLX_SI%dgsave ) THEN 
     5075             CALL iom_put( "INTFLX_SI"  , fflx_si ) 
     5076         ENDIF 
     5077         IF ( med_diag%INTFLX_FE%dgsave ) THEN 
     5078             CALL iom_put( "INTFLX_FE"  , fflx_fe ) 
     5079         ENDIF         
     5080         IF ( med_diag%INT_PN%dgsave ) THEN 
     5081             CALL iom_put( "INT_PN"  , ftot_pn ) 
     5082         ENDIF 
     5083         IF ( med_diag%INT_PD%dgsave ) THEN 
     5084             CALL iom_put( "INT_PD"  , ftot_pd ) 
     5085         ENDIF          
     5086         IF ( med_diag%INT_ZMI%dgsave ) THEN 
     5087             CALL iom_put( "INT_ZMI"  , ftot_zmi ) 
     5088         ENDIF 
     5089         IF ( med_diag%INT_ZME%dgsave ) THEN 
     5090             CALL iom_put( "INT_ZME"  , ftot_zme ) 
     5091         ENDIF 
     5092         IF ( med_diag%INT_DET%dgsave ) THEN 
     5093             CALL iom_put( "INT_DET"  , ftot_det ) 
     5094         ENDIF 
     5095         IF ( med_diag%INT_DTC%dgsave ) THEN 
     5096             CALL iom_put( "INT_DTC"  , ftot_dtc ) 
     5097         ENDIF 
     5098         IF ( med_diag%BEN_N%dgsave ) THEN 
     5099             CALL iom_put( "BEN_N"  , za_sed_n ) 
     5100         ENDIF 
     5101         IF ( med_diag%BEN_FE%dgsave ) THEN 
     5102             CALL iom_put( "BEN_FE"  , za_sed_fe ) 
     5103         ENDIF 
     5104         IF ( med_diag%BEN_C%dgsave ) THEN 
     5105             CALL iom_put( "BEN_C"  , za_sed_c ) 
     5106         ENDIF 
     5107         IF ( med_diag%BEN_SI%dgsave ) THEN 
     5108             CALL iom_put( "BEN_SI"  , za_sed_si ) 
     5109         ENDIF 
     5110         IF ( med_diag%BEN_CA%dgsave ) THEN 
     5111             CALL iom_put( "BEN_CA"  , za_sed_ca ) 
     5112         ENDIF 
     5113         IF ( med_diag%RUNOFF%dgsave ) THEN 
     5114             CALL iom_put( "RUNOFF"  , f_runoff ) 
     5115         ENDIF  
     5116# if defined key_roam         
     5117         IF ( med_diag%N_PROD%dgsave ) THEN 
     5118             CALL iom_put( "N_PROD"  , fnit_prod ) 
     5119         ENDIF 
     5120         IF ( med_diag%N_CONS%dgsave ) THEN 
     5121             CALL iom_put( "N_CONS"  , fnit_cons ) 
     5122         ENDIF 
     5123         IF ( med_diag%C_PROD%dgsave ) THEN 
     5124             CALL iom_put( "C_PROD"  , fcar_prod ) 
     5125         ENDIF 
     5126         IF ( med_diag%C_CONS%dgsave ) THEN 
     5127             CALL iom_put( "C_CONS"  , fcar_cons ) 
     5128         ENDIF 
     5129         IF ( med_diag%O2_PROD%dgsave ) THEN 
     5130             CALL iom_put( "O2_PROD"  , foxy_prod ) 
     5131         ENDIF 
     5132         IF ( med_diag%O2_CONS%dgsave ) THEN 
     5133             CALL iom_put( "O2_CONS"  , foxy_cons ) 
     5134         ENDIF 
     5135         IF ( med_diag%O2_ANOX%dgsave ) THEN 
     5136             CALL iom_put( "O2_ANOX"  , foxy_anox ) 
     5137         ENDIF 
     5138         IF ( med_diag%INVTC%dgsave ) THEN 
     5139             CALL iom_put( "INVTC"  , ftot_c ) 
     5140         ENDIF 
     5141         IF ( med_diag%INVTALK%dgsave ) THEN 
     5142             CALL iom_put( "INVTALK"  , ftot_a ) 
     5143         ENDIF 
     5144         IF ( med_diag%INVTO2%dgsave ) THEN 
     5145            CALL iom_put( "INVTO2"  , ftot_o2 ) 
     5146         ENDIF 
     5147         IF ( med_diag%COM_RESP%dgsave ) THEN 
     5148             CALL iom_put( "COM_RESP"  , fcomm_resp ) 
     5149         ENDIF          
     5150# endif       
     5151         !! 
     5152         !! diagnostic filled in the i-j-k main loop 
     5153         !!-------------------------------------------- 
     5154        IF ( med_diag%PRN%dgsave ) THEN 
     5155            CALL iom_put( "PRN"  , fprn2d ) 
     5156            CALL wrk_dealloc( jpi, jpj,   fprn2d   ) 
     5157        ENDIF 
     5158        IF ( med_diag%MPN%dgsave ) THEN 
     5159            CALL iom_put( "MPN"  ,fdpn2d  ) 
     5160            CALL wrk_dealloc( jpi, jpj,    fdpn2d  ) 
     5161        ENDIF 
     5162        IF ( med_diag%PRD%dgsave ) THEN 
     5163            CALL iom_put( "PRD"  ,fprd2d  ) 
     5164            CALL wrk_dealloc( jpi, jpj,   fprd2d  ) 
     5165        ENDIF 
     5166        IF( med_diag%MPD%dgsave ) THEN 
     5167            CALL iom_put( "MPD"  , fdpd2d ) 
     5168            CALL wrk_dealloc( jpi, jpj,    fdpd2d ) 
     5169        ENDIF 
     5170        !  IF( med_diag%DSED%dgsave ) THEN 
     5171        !      CALL iom_put( "DSED"  , ftot_n ) 
     5172        !  ENDIF 
     5173        IF( med_diag%OPAL%dgsave ) THEN 
     5174            CALL iom_put( "OPAL"  , fprds2d ) 
     5175            CALL wrk_dealloc( jpi, jpj,   fprds2d  ) 
     5176        ENDIF 
     5177        IF( med_diag%OPALDISS%dgsave ) THEN 
     5178            CALL iom_put( "OPALDISS"  , fsdiss2d ) 
     5179            CALL wrk_dealloc( jpi, jpj,   fsdiss2d  ) 
     5180        ENDIF 
     5181        IF( med_diag%GMIPn%dgsave ) THEN 
     5182            CALL iom_put( "GMIPn"  , fgmipn2d ) 
     5183            CALL wrk_dealloc( jpi, jpj,   fgmipn2d  ) 
     5184        ENDIF 
     5185        IF( med_diag%GMID%dgsave ) THEN 
     5186            CALL iom_put( "GMID"  , fgmid2d ) 
     5187            CALL wrk_dealloc( jpi, jpj,  fgmid2d  ) 
     5188        ENDIF 
     5189        IF( med_diag%MZMI%dgsave ) THEN 
     5190            CALL iom_put( "MZMI"  , fdzmi2d ) 
     5191            CALL wrk_dealloc( jpi, jpj,   fdzmi2d   ) 
     5192        ENDIF 
     5193        IF( med_diag%GMEPN%dgsave ) THEN 
     5194            CALL iom_put( "GMEPN"  , fgmepn2d ) 
     5195            CALL wrk_dealloc( jpi, jpj,   fgmepn2d  ) 
     5196        ENDIF 
     5197        IF( med_diag%GMEPD%dgsave ) THEN 
     5198            CALL iom_put( "GMEPD"  , fgmepd2d ) 
     5199            CALL wrk_dealloc( jpi, jpj,   fgmepd2d   ) 
     5200        ENDIF 
     5201        IF( med_diag%GMEZMI%dgsave ) THEN 
     5202            CALL iom_put( "GMEZMI"  , fgmezmi2d ) 
     5203            CALL wrk_dealloc( jpi, jpj,   fgmezmi2d   ) 
     5204        ENDIF 
     5205        IF( med_diag%GMED%dgsave ) THEN 
     5206            CALL iom_put( "GMED"  , fgmed2d ) 
     5207            CALL wrk_dealloc( jpi, jpj,    fgmed2d  ) 
     5208        ENDIF 
     5209        IF( med_diag%MZME%dgsave ) THEN 
     5210            CALL iom_put( "MZME"  , fdzme2d ) 
     5211            CALL wrk_dealloc( jpi, jpj,  fdzme2d    ) 
     5212        ENDIF 
     5213        !  IF( med_diag%DEXP%dgsave ) THEN 
     5214        !      CALL iom_put( "DEXP"  , ftot_n ) 
     5215        !  ENDIF 
     5216        IF( med_diag%DETN%dgsave ) THEN 
     5217            CALL iom_put( "DETN"  , fslown2d ) 
     5218            CALL wrk_dealloc( jpi, jpj,  fslown2d    ) 
     5219        ENDIF 
     5220        IF( med_diag%MDET%dgsave ) THEN 
     5221            CALL iom_put( "MDET"  , fdd2d ) 
     5222            CALL wrk_dealloc( jpi, jpj,   fdd2d   ) 
     5223        ENDIF 
     5224        IF( med_diag%AEOLIAN%dgsave ) THEN 
     5225            CALL iom_put( "AEOLIAN"  , ffetop2d ) 
     5226            CALL wrk_dealloc( jpi, jpj,   ffetop2d   ) 
     5227        ENDIF 
     5228        IF( med_diag%BENTHIC%dgsave ) THEN 
     5229            CALL iom_put( "BENTHIC"  , ffebot2d ) 
     5230            CALL wrk_dealloc( jpi, jpj,   ffebot2d   ) 
     5231        ENDIF 
     5232        IF( med_diag%SCAVENGE%dgsave ) THEN 
     5233            CALL iom_put( "SCAVENGE"  , ffescav2d ) 
     5234            CALL wrk_dealloc( jpi, jpj,   ffescav2d  ) 
     5235        ENDIF 
     5236        !!  
     5237        IF( med_diag%TOTREG_N%dgsave ) THEN 
     5238            CALL iom_put( "TOTREG_N"  , fregen2d ) 
     5239            CALL wrk_dealloc( jpi, jpj,   fregen2d   ) 
     5240        ENDIF 
     5241        IF( med_diag%TOTRG_SI%dgsave ) THEN 
     5242            CALL iom_put( "TOTRG_SI"  , fregensi2d ) 
     5243            CALL wrk_dealloc( jpi, jpj,    fregensi2d  ) 
     5244        ENDIF 
     5245        !!  
     5246        IF( med_diag%FASTN%dgsave ) THEN 
     5247            CALL iom_put( "FASTN"  , ftempn2d ) 
     5248            CALL wrk_dealloc( jpi, jpj,   ftempn2d   ) 
     5249        ENDIF 
     5250        IF( med_diag%FASTSI%dgsave ) THEN 
     5251            CALL iom_put( "FASTSI"  , ftempsi2d ) 
     5252            CALL wrk_dealloc( jpi, jpj,   ftempsi2d   ) 
     5253        ENDIF 
     5254        IF( med_diag%FASTFE%dgsave ) THEN 
     5255            CALL iom_put( "FASTFE"  , ftempfe2d ) 
     5256            CALL wrk_dealloc( jpi, jpj,    ftempfe2d  ) 
     5257        ENDIF 
     5258        IF( med_diag%FASTC%dgsave ) THEN 
     5259            CALL iom_put( "FASTC"  , ftempc2d ) 
     5260            CALL wrk_dealloc( jpi, jpj,  ftempc2d    ) 
     5261        ENDIF 
     5262        IF( med_diag%FASTCA%dgsave ) THEN 
     5263            CALL iom_put( "FASTCA"  , ftempca2d ) 
     5264           CALL wrk_dealloc( jpi, jpj,  ftempca2d   ) 
     5265        ENDIF 
     5266        !!  
     5267        IF( med_diag%REMINN%dgsave ) THEN 
     5268            CALL iom_put( "REMINN"  , freminn2d ) 
     5269            CALL wrk_dealloc( jpi, jpj,   freminn2d   ) 
     5270        ENDIF 
     5271        IF( med_diag%REMINSI%dgsave ) THEN 
     5272            CALL iom_put( "REMINSI"  , freminsi2d ) 
     5273            CALL wrk_dealloc( jpi, jpj,   freminsi2d   ) 
     5274        ENDIF 
     5275        IF( med_diag%REMINFE%dgsave ) THEN 
     5276            CALL iom_put( "REMINFE"  , freminfe2d ) 
     5277            CALL wrk_dealloc( jpi, jpj,  freminfe2d    ) 
     5278        ENDIF 
     5279        IF( med_diag%REMINC%dgsave ) THEN 
     5280            CALL iom_put( "REMINC"  , freminc2d ) 
     5281            CALL wrk_dealloc( jpi, jpj,    freminc2d  ) 
     5282        ENDIF 
     5283        IF( med_diag%REMINCA%dgsave ) THEN 
     5284            CALL iom_put( "REMINCA"  , freminca2d ) 
     5285             CALL wrk_dealloc( jpi, jpj,   freminca2d  ) 
     5286        ENDIF 
     5287        IF( med_diag%SEAFLRN%dgsave ) THEN 
     5288            CALL iom_put( "SEAFLRN"  , fsedn ) 
     5289        ENDIF 
     5290        IF( med_diag%SEAFLRSI%dgsave ) THEN 
     5291            CALL iom_put( "SEAFLRSI"  , fsedsi ) 
     5292        ENDIF 
     5293        IF( med_diag%SEAFLRFE%dgsave ) THEN 
     5294            CALL iom_put( "SEAFLRFE"  , fsedfe ) 
     5295        ENDIF 
     5296        IF( med_diag%SEAFLRC%dgsave ) THEN 
     5297            CALL iom_put( "SEAFLRC"  , fsedc ) 
     5298        ENDIF 
     5299        IF( med_diag%SEAFLRCA%dgsave ) THEN 
     5300            CALL iom_put( "SEAFLRCA"  , fsedca ) 
     5301        ENDIF 
     5302 
     5303        !! 
     5304        !! 
     5305        !! 
     5306        !!   
     5307        !!  
     5308        !! 
     5309        !!  
     5310        !! 
     5311        !! 
     5312# if defined key_roam             
     5313        !! 
     5314        !! 
     5315        IF( med_diag%RIV_N%dgsave ) THEN 
     5316            CALL iom_put( "RIV_N"  , rivn2d ) 
     5317             CALL wrk_dealloc( jpi, jpj,    rivn2d  ) 
     5318        ENDIF 
     5319        IF( med_diag%RIV_SI%dgsave ) THEN 
     5320            CALL iom_put( "RIV_SI"  , rivsi2d ) 
     5321             CALL wrk_dealloc( jpi, jpj,   rivsi2d   ) 
     5322        ENDIF 
     5323        IF( med_diag%RIV_C%dgsave ) THEN 
     5324            CALL iom_put( "RIV_C"  , rivc2d ) 
     5325             CALL wrk_dealloc( jpi, jpj,    rivc2d  ) 
     5326        ENDIF 
     5327        IF( med_diag%RIV_ALK%dgsave ) THEN 
     5328            CALL iom_put( "RIV_ALK"  , rivalk2d ) 
     5329             CALL wrk_dealloc( jpi, jpj,  rivalk2d    ) 
     5330        ENDIF 
     5331        IF( med_diag%DETC%dgsave ) THEN 
     5332            CALL iom_put( "DETC"  , fslowc2d ) 
     5333             CALL wrk_dealloc( jpi, jpj,   fslowc2d   ) 
     5334        ENDIF 
     5335        !!  
     5336        !!               
     5337        !! 
     5338        IF( med_diag%PN_LLOSS%dgsave ) THEN 
     5339            CALL iom_put( "PN_LLOSS"  , fdpn22d ) 
     5340             CALL wrk_dealloc( jpi, jpj,   fdpn22d   ) 
     5341        ENDIF 
     5342        IF( med_diag%PD_LLOSS%dgsave ) THEN 
     5343            CALL iom_put( "PD_LLOSS"  , fdpd22d ) 
     5344             CALL wrk_dealloc( jpi, jpj,   fdpd22d   ) 
     5345        ENDIF 
     5346        IF( med_diag%ZI_LLOSS%dgsave ) THEN 
     5347            CALL iom_put( "ZI_LLOSS"  , fdzmi22d ) 
     5348             CALL wrk_dealloc( jpi, jpj,    fdzmi22d  ) 
     5349        ENDIF 
     5350        IF( med_diag%ZE_LLOSS%dgsave ) THEN 
     5351            CALL iom_put( "ZE_LLOSS"  , fdzme22d ) 
     5352             CALL wrk_dealloc( jpi, jpj,   fdzme22d   ) 
     5353        ENDIF 
     5354        IF( med_diag%ZI_MES_N%dgsave ) THEN 
     5355            CALL iom_put( "ZI_MES_N"  , zimesn2d ) 
     5356             CALL wrk_dealloc( jpi, jpj,    zimesn2d  ) 
     5357        ENDIF 
     5358        IF( med_diag%ZI_MES_D%dgsave ) THEN 
     5359            CALL iom_put( "ZI_MES_D"  , zimesd2d ) 
     5360             CALL wrk_dealloc( jpi, jpj,    zimesd2d  ) 
     5361        ENDIF 
     5362        IF( med_diag%ZI_MES_C%dgsave ) THEN 
     5363            CALL iom_put( "ZI_MES_C"  , zimesc2d ) 
     5364             CALL wrk_dealloc( jpi, jpj,    zimesc2d  ) 
     5365        ENDIF 
     5366        IF( med_diag%ZI_MESDC%dgsave ) THEN 
     5367            CALL iom_put( "ZI_MESDC"  ,zimesdc2d  ) 
     5368             CALL wrk_dealloc( jpi, jpj,    zimesdc2d  ) 
     5369        ENDIF 
     5370        IF( med_diag%ZI_EXCR%dgsave ) THEN 
     5371            CALL iom_put( "ZI_EXCR"  , ziexcr2d ) 
     5372             CALL wrk_dealloc( jpi, jpj,    ziexcr2d ) 
     5373        ENDIF 
     5374        IF( med_diag%ZI_RESP%dgsave ) THEN 
     5375            CALL iom_put( "ZI_RESP"  , ziresp2d ) 
     5376             CALL wrk_dealloc( jpi, jpj,   ziresp2d   ) 
     5377        ENDIF 
     5378        IF( med_diag%ZI_GROW%dgsave ) THEN 
     5379            CALL iom_put( "ZI_GROW"  , zigrow2d ) 
     5380             CALL wrk_dealloc( jpi, jpj,   zigrow2d   ) 
     5381        ENDIF 
     5382        IF( med_diag%ZE_MES_N%dgsave ) THEN 
     5383            CALL iom_put( "ZE_MES_N"  , zemesn2d ) 
     5384             CALL wrk_dealloc( jpi, jpj,    zemesn2d  ) 
     5385        ENDIF 
     5386        IF( med_diag%ZE_MES_D%dgsave ) THEN 
     5387            CALL iom_put( "ZE_MES_D"  , zemesd2d ) 
     5388             CALL wrk_dealloc( jpi, jpj,    zemesd2d  ) 
     5389        ENDIF 
     5390        IF( med_diag%ZE_MES_C%dgsave ) THEN 
     5391            CALL iom_put( "ZE_MES_C"  , zemesc2d ) 
     5392             CALL wrk_dealloc( jpi, jpj,   zemesc2d   ) 
     5393        ENDIF 
     5394        IF( med_diag%ZE_MESDC%dgsave ) THEN 
     5395            CALL iom_put( "ZE_MESDC"  , zemesdc2d ) 
     5396             CALL wrk_dealloc( jpi, jpj,   zemesdc2d   ) 
     5397        ENDIF 
     5398        IF( med_diag%ZE_EXCR%dgsave ) THEN 
     5399            CALL iom_put( "ZE_EXCR"  , zeexcr2d ) 
     5400             CALL wrk_dealloc( jpi, jpj,   zeexcr2d   ) 
     5401        ENDIF 
     5402        IF( med_diag%ZE_RESP%dgsave ) THEN 
     5403            CALL iom_put( "ZE_RESP"  , zeresp2d ) 
     5404             CALL wrk_dealloc( jpi, jpj,    zeresp2d  ) 
     5405        ENDIF 
     5406        IF( med_diag%ZE_GROW%dgsave ) THEN 
     5407            CALL iom_put( "ZE_GROW"  , zegrow2d ) 
     5408             CALL wrk_dealloc( jpi, jpj,   zegrow2d   ) 
     5409        ENDIF 
     5410        IF( med_diag%MDETC%dgsave ) THEN 
     5411            CALL iom_put( "MDETC"  , mdetc2d ) 
     5412             CALL wrk_dealloc( jpi, jpj,   mdetc2d   ) 
     5413        ENDIF 
     5414        IF( med_diag%GMIDC%dgsave ) THEN 
     5415            CALL iom_put( "GMIDC"  , gmidc2d ) 
     5416             CALL wrk_dealloc( jpi, jpj,    gmidc2d  ) 
     5417        ENDIF 
     5418        IF( med_diag%GMEDC%dgsave ) THEN 
     5419            CALL iom_put( "GMEDC"  , gmedc2d ) 
     5420             CALL wrk_dealloc( jpi, jpj,    gmedc2d  ) 
     5421        ENDIF 
     5422        IF( med_diag%IBEN_N%dgsave ) THEN 
     5423           CALL iom_put( "IBEN_N"  , iben_n2d ) 
     5424             CALL wrk_dealloc( jpi, jpj,    iben_n2d  ) 
     5425        ENDIF 
     5426        IF( med_diag%IBEN_FE%dgsave ) THEN 
     5427           CALL iom_put( "IBEN_FE"  , iben_fe2d ) 
     5428             CALL wrk_dealloc( jpi, jpj,   iben_fe2d   ) 
     5429        ENDIF 
     5430        IF( med_diag%IBEN_C%dgsave ) THEN 
     5431           CALL iom_put( "IBEN_C"  , iben_c2d ) 
     5432             CALL wrk_dealloc( jpi, jpj,   iben_c2d   ) 
     5433        ENDIF 
     5434        IF( med_diag%IBEN_SI%dgsave ) THEN 
     5435           CALL iom_put( "IBEN_SI"  , iben_si2d ) 
     5436             CALL wrk_dealloc( jpi, jpj,   iben_si2d   ) 
     5437        ENDIF 
     5438        IF( med_diag%IBEN_CA%dgsave ) THEN 
     5439           CALL iom_put( "IBEN_CA"  , iben_ca2d ) 
     5440             CALL wrk_dealloc( jpi, jpj,   iben_ca2d   ) 
     5441        ENDIF 
     5442        IF( med_diag%OBEN_N%dgsave ) THEN 
     5443           CALL iom_put( "OBEN_N"  , oben_n2d ) 
     5444             CALL wrk_dealloc( jpi, jpj,    oben_n2d  ) 
     5445        ENDIF 
     5446        IF( med_diag%OBEN_FE%dgsave ) THEN 
     5447           CALL iom_put( "OBEN_FE"  , oben_fe2d ) 
     5448             CALL wrk_dealloc( jpi, jpj,    oben_fe2d  ) 
     5449        ENDIF 
     5450        IF( med_diag%OBEN_C%dgsave ) THEN 
     5451           CALL iom_put( "OBEN_C"  , oben_c2d ) 
     5452             CALL wrk_dealloc( jpi, jpj,    oben_c2d  ) 
     5453        ENDIF 
     5454        IF( med_diag%OBEN_SI%dgsave ) THEN 
     5455           CALL iom_put( "OBEN_SI"  , oben_si2d ) 
     5456             CALL wrk_dealloc( jpi, jpj,    oben_si2d  ) 
     5457        ENDIF 
     5458        IF( med_diag%OBEN_CA%dgsave ) THEN 
     5459           CALL iom_put( "OBEN_CA"  , oben_ca2d ) 
     5460             CALL wrk_dealloc( jpi, jpj, oben_ca2d     ) 
     5461        ENDIF 
     5462        IF( med_diag%SFR_OCAL%dgsave ) THEN 
     5463           CALL iom_put( "SFR_OCAL"  , sfr_ocal2d ) 
     5464             CALL wrk_dealloc( jpi, jpj,    sfr_ocal2d  ) 
     5465        ENDIF 
     5466        IF( med_diag%SFR_OARG%dgsave ) THEN 
     5467           CALL iom_put( "SFR_OARG"  , sfr_oarg2d ) 
     5468             CALL wrk_dealloc( jpi, jpj,    sfr_oarg2d  ) 
     5469        ENDIF 
     5470        IF( med_diag%LYSO_CA%dgsave ) THEN 
     5471           CALL iom_put( "LYSO_CA"  , lyso_ca2d ) 
     5472             CALL wrk_dealloc( jpi, jpj,    lyso_ca2d  ) 
     5473        ENDIF 
     5474# endif                    
     5475         !!           
     5476         !! 
     5477         !! ** 3D diagnostics 
     5478         IF( med_diag%TPP3%dgsave ) THEN 
     5479             CALL iom_put( "TPP3"  , tpp3d ) 
     5480              CALL wrk_dealloc( jpi, jpj, jpk,   tpp3d  ) 
     5481         ENDIF 
     5482         IF( med_diag%DETFLUX3%dgsave ) THEN 
     5483             CALL iom_put( "DETFLUX3"  , detflux3d ) 
     5484              CALL wrk_dealloc( jpi, jpj, jpk,    detflux3d ) 
     5485         ENDIF 
     5486          IF( med_diag%REMIN3N%dgsave ) THEN 
     5487             CALL iom_put( "REMIN3N"  , remin3dn ) 
     5488             CALL wrk_dealloc( jpi, jpj, jpk,   remin3dn  ) 
     5489          ENDIF 
     5490# if defined key_roam           
     5491          IF( med_diag%PH3%dgsave ) THEN 
     5492              CALL iom_put( "PH3"  , f3_pH ) 
     5493          ENDIF 
     5494          IF( med_diag%OM_CAL3%dgsave ) THEN 
     5495              CALL iom_put( "OM_CAL3"  , f3_omcal ) 
     5496          ENDIF 
     5497# endif          
     5498 
     5499      CALL wrk_dealloc( jpi, jpj,   zw2d   ) 
     5500 
     5501     ENDIF ! end of ln_diatrc option 
    35735502 
    35745503# if defined key_trc_diabio 
    … …  
    35765505      DO jn=1,jp_medusa_trd 
    35775506          CALL lbc_lnk(trbio(:,:,1,jn),'T',1. ) 
    3578       END DO  
     5507      ENDDO  
    35795508# endif 
    35805509 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcco2_medusa.F90

    r5726 r6639  
    4747!======================================================================= 
    4848! 
    49       SUBROUTINE trc_co2_medusa( Temp, Sal, DIC, ALK, Depth, Wnd, pCO2a, & 
     49      SUBROUTINE trc_co2_medusa( Temp, Sal, DIC, ALK, Depth, xkw, pCO2a, & 
    5050      pH, pCO2w, h2co3, hco3, co3, om_cal, om_arg, co2flux, TDIC, TALK,  & 
    5151      dcf, henry, iters ) 
    … …  
    7272! 17/02/2010. Update calculation of K1, K2, Kb to make consistant with the OCMIP protocols. 
    7373! 29/07/2011. Merged into MEDUSA with a raft of changes to this subroutine; less elsewhere 
     74! 23/06/2015. Modified to take gas transfer velocity as an input (rather than wind speed);  
     75!             alter CO2 flux to /s rather than /d for consistency with other schemes 
    7476! 
    7577! Changes for MEDUSA include:  
    … …  
    8587      REAL(wp), INTENT( in )    :: ALK        ! meq  / m3 
    8688      REAL(wp), INTENT( in )    :: Depth      ! m 
    87       REAL(wp), INTENT( in )    :: Wnd        ! m / s 
     89!     REAL(wp), INTENT( in )    :: Wnd        ! m / s 
     90      REAL(wp), INTENT( in )    :: xkw        ! m / s 
    8891      REAL(wp), INTENT( in )    :: pCO2a      ! uatm 
    8992!---------------------------------------------------------------------- 
    … …  
    9598      REAL(wp), INTENT( inout ) :: om_cal     ! normalised 
    9699      REAL(wp), INTENT( inout ) :: om_arg     ! normalised 
    97       REAL(wp), INTENT( inout ) :: co2flux    ! mmol / m2 / d 
     100      REAL(wp), INTENT( inout ) :: co2flux    ! mmol / m2 / s 
    98101      REAL(wp), INTENT( inout ) :: TDIC       ! umol / kg 
    99102      REAL(wp), INTENT( inout ) :: TALK       ! ueq  / kg 
    … …  
    129132   !                 (i.e. surface calculations being performed) 
    130133   if (Depth .eq. 0.0) then 
    131       call Air_sea_exchange( Temp, Wnd, pCO2w, pCO2a, henry, dcf, &         ! inputs 
     134      call Air_sea_exchange( Temp, xkw, pCO2w, pCO2a, henry, dcf, &         ! inputs 
    132135         co2flux )                                                          ! output 
    133136   else 
    … …  
    145148      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: zdic    =', DIC 
    146149      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: zalk    =', ALK 
    147       IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_wind  =', Wnd 
     150      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_kw660 =', xkw 
    148151      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_ph    =', ph 
    149152      IF(lwp) WRITE(numout,*) ' trc_co2_medusa: f_pco2w =', pCO2w 
    … …  
    162165      &        ' DIC', DIC, ' ALK', ALK 
    163166      if (lwp) write (numout,'(a,a,f10.3,a,f10.3)') 'CO2FLUX-NAN', & 
    164       &        ' WND', Wnd, ' PH ', ph 
     167      &        ' XKW', xkw, ' PH ', ph 
    165168      if (lwp) write (numout,'(a,a,i6)') 'CO2FLUX-NAN', & 
    166169      &        ' ITERS', iters 
    … …  
    196199!  WRITE(*,'(A27,F10.3)') "    Omega calcite       (~) = ", om_cal 
    197200!  WRITE(*,'(A27,F10.3)') "    Omega aragonite     (~) = ", om_arg 
    198 !  WRITE(*,'(A27,F10.3)') "    air sea flux(mmol/m2/d) = ", flux 
     201!  WRITE(*,'(A27,F10.3)') "    air sea flux(mmol/m2/s) = ", flux 
    199202!  WRITE(*,*) " " 
    200203 
    … …  
    287290!======================================================================= 
    288291! 
    289       SUBROUTINE Air_sea_exchange( T, Wnd, pco2w, pco2a, henry, dcf, & 
     292      SUBROUTINE Air_sea_exchange( T, xkw, pco2w, pco2a, henry, dcf, & 
    290293      flux ) 
    291294!       
    … …  
    302305!  pCO2a    partial pressure of CO2 in the atmosphere (usually external forcing). 
    303306!  T        temperature (C) 
    304 !  Wnd      wind speed, metres 
     307!  Wnd      wind speed, metres (DELETED) 
     308!  xkw      gas transfer velocity 
    305309!  Henry    henry's constant 
    306310!  density  the density of water for conversion between mmol/m3 and umol/kg 
    … …  
    312316   IMPLICIT NONE 
    313317 
    314       REAL(wp), INTENT( in )    :: T, wnd, pco2w, pco2a, henry, dcf ! INPUT PARAMETERS: 
     318      REAL(wp), INTENT( in )    :: T, xkw, pco2w, pco2a, henry, dcf ! INPUT PARAMETERS: 
    315319!----------------------------------------------------------------------- 
    316320      REAL(wp), INTENT( inout ) :: flux                             ! OUTPUT Variables 
    … …  
    320324! calculate the Schmidt number and unit conversions 
    321325          sc    = 2073.1-125.62*T+3.6276*T**2.0-0.0432190*T**3.0 
    322           fwind = (0.222d0 * wnd**2d0 + 0.333d0 * wnd)*(sc/660.d0)**(-0.5) 
     326!         fwind = (0.222d0 * wnd**2d0 + 0.333d0 * wnd)*(sc/660.d0)**(-0.5) 
     327          fwind = xkw * (sc/660.d0)**(-0.5) 
    323328          fwind = fwind*24.d0/100.d0   ! convert to m/day 
    324329 
    … …  
    326331! here it is rescaled to mmol/m2/d 
    327332          flux = fwind * henry * ( pco2a - pco2w ) * dcf 
     333 
     334! AXY (23/06/15): let's get it from /d to /s 
     335          flux = flux / ( 86400. ) 
    328336 
    329337  RETURN  

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90

    r5726 r6639  
    3939! 
    4040   SUBROUTINE trc_dms_medusa( chn, chd, mld, xqsr, xdin,   &  !! inputs 
    41      &  dms_surf, dms_andr, dms_simo, dms_aran, dms_hall )    !! outputs 
     41     &  dms_andr, dms_simo, dms_aran, dms_hall )              !! outputs 
    4242!       
    4343!======================================================================= 
    … …  
    7070      !!                    published (and different from the above) 
    7171      !! 
     72      !! AXY (08/07/15): amend to remove Julien's original calculation 
     73      !!                 as this is now superfluous; the four schemes  
     74      !!                 are calculated and one is chosen to be passed 
     75      !!                 to the atmosphere in trc_bio_medusa 
     76      !! 
    7277!======================================================================= 
    7378 
    … …  
    7984      REAL(wp), INTENT( in )    :: xqsr                 !! surface irradiance        (W/m2) 
    8085      REAL(wp), INTENT( in )    :: xdin                 !! surface DIN               (mmol N/m3) 
    81       REAL(wp), INTENT( inout ) :: dms_surf             !! DMS surface concentration (mol/m3)  
    8286      REAL(wp), INTENT( inout ) :: dms_andr             !! DMS surface concentration (mol/m3)  
    8387      REAL(wp), INTENT( inout ) :: dms_simo             !! DMS surface concentration (mol/m3)  
    … …  
    8993      !! temporary variables 
    9094      REAL(wp) ::    fq1,fq2,fq3 
    91 ! 
    92 !! IJT (30/03/13): DMS calc needs this 
    93 !! Julien : in Simo & Dachs, GBC, 2002, DMS is derived from  
    94 !!          CHL/MLD ratio in mg/m4 (i.e. CHL is in mg/m3 
    95 !!          MLD in m). 
    96 !!          In MEDUSA, we already have CHL in mg/m3 for both 
    97 !!          Diatoms and non-diatoms (zchn,zchd); and mld from 
    98 !!          NEMO (hmld) in m. 
    99       CHL = 0.0 
    100 !! 
    101 !!            CHL = mask * TT(I,J,1,PHYTO_TRACER) & 
    102 !!     &       * c2n_p * mw_carbon / CCHL_P(I,J,1,1) 
    103       CHL = chn+chd                                 !! mg/m3  
    104 !! 
    105 !! ------------------------------------------------ 
    106 !!  Calculate the DMS concentration in nM (nanomol/litre) 
    107 !!   from Simo & Dachs, GBC, 2002, modified to be positive-definite 
    108 !!   for MLD>182.536m, using DMS=90./MLD (Aranami & Tsunogai, JGR, 2004) 
    109 !!   Multiply by 1.0E-6 to convert nM to (mol/m3) 
    110 !!       cmr = fm(i,1)*chl/mld(i) 
    111 !!       IF (cmr .lt. 0.02) THEN 
    112 !!         IF (mld(i) .le. 182.536) THEN 
    113 !!           csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(-LOG(mld(i)) + 5.7) 
    114 !!         ELSE 
    115 !!           csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(90./mld(i)) 
    116 !!         ENDIF 
    117 !!       ELSE 
    118 !!         csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(55.8*cmr + 0.6) 
    119 !!       ENDIF 
    120 !! 
    121         cmr      = CHL / mld 
    122 !       sw_dms   = 0.5 + SIGN( 0.5, cmr - 0.02 ) 
    123 !! Jpalm (11-08-2014) 
    124 !! Explanation about the SIGN function : 
    125 !! not easy to read, but maybe "more elegant and efficient") 
    126 !! here for example:  
    127 !! sw_dms = 1 if cmr is greater than 0.02, 
    128 !!          0 if cmr lower than 0.02 
    129 !! then  
    130 !! if cmr < 0.02 
    131 !!  dms_surf =  1.0e-6 * 90.0 / mld  
    132 !!       or  =  1.0e-6 * 5.7 - LOG(mld) 
    133 !! and if cmr > 0.02 
    134 !!  dms_surf = 1.0e-6 * ( 55.8 * cmr + 0.6 ) 
    135 !! what is equivalent to the IF loops formulations. 
    136 !! difference is on the stresholds between mld = 182.536m 
    137 !! (strange value...) 
    138 !! and the Max function... that stay uncertain. 
    139 !! 
    140 !        dms_surf = 1.0e-6 * ( sw_dms *             & 
    141 !     &  ( 55.8 * cmr + 0.6 ) + ( 1.0 - sw_dms ) *  & 
    142 !     &  ( MAX( 90.0 / mld, 5.7 - LOG(mld) ) ) ) 
    143 ! 
    144 ! AXY (12/01/15): the DMS equation donated by the UKMO does not match 
    145 !                 that reported in Halloran et al. (2010); amend the 
    146 !                 equations appropriately 
    147 ! 
    148         if (cmr .lt. 0.02) then 
    149            dms_surf = (-1.0 * log(mld)) + 5.7 
    150         else 
    151            dms_surf = (55.8 * cmr) + 0.6 
    152         endif 
    153 !     
    154         if (mld > 182.5) then 
    155            dms_surf = (90.0 / mld) 
    156         endif 
    157 !      
    158         dms_surf = 1.0e-6 * dms_surf 
    159  
    16095!  
    16196!======================================================================= 
    … …  
    16398! AXY (13/03/15): per remarks above, the following calculations estimate 
    16499!                 DMS using all of the schemes examined for UKESM1 
     100! 
     101      CHL = 0.0 
     102      CHL = chn+chd                                 !! mg/m3  
     103      cmr = CHL / mld 
    165104! 
    166105! AXY (13/03/15): Anderson et al. (2001) 
    … …  
    180119! 
    181120! AXY (13/03/15): Simo & Dachs (2002) 
    182         cmr = CHL / mld 
    183121        fq1 = (-1 * log(mld)) + 5.7 
    184122        fq2 = (55.8 * cmr) + 0.6 
    … …  
    191129!            
    192130! AXY (13/03/15): Aranami & Tsunogai (2004) 
    193         cmr = CHL / mld 
    194131        fq1 = 60.0 / mld 
    195132        fq2 = (55.8 * cmr) + 0.6 
    … …  
    202139!         
    203140! AXY (13/03/15): Halloran et al. (2010) 
    204         cmr = CHL / mld 
    205141        fq1 = (-1 * log(mld)) + 5.7 
    206142        fq2 = (55.8 * cmr) + 0.6 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90

    r5726 r6639  
    3636   LOGICAL, PUBLIC ::                  & 
    3737      bocalccd = .TRUE. 
     38   !! JPALM (14/09/15) 
     39   LOGICAL, PUBLIC ::                  & 
     40      ln_ccd = .TRUE. 
     41 
    3842   INTEGER ::                          & 
    3943      numccd 
    … …  
    232236      
    233237      !!---------------------------------------------------------------------- 
     238      !! Averaged properties for DMS calculations (various units) 
     239      !!---------------------------------------------------------------------- 
     240      !!      
     241      !! these store temporally averaged properties for DMS calculations (AXY, 07/07/15) 
     242      zb_dms_chn(:,:)  = 0.0  !! CHN 
     243      zn_dms_chn(:,:)  = 0.0 
     244      za_dms_chn(:,:)  = 0.0 
     245      zb_dms_chd(:,:)  = 0.0  !! CHD 
     246      zn_dms_chd(:,:)  = 0.0 
     247      za_dms_chd(:,:)  = 0.0 
     248      zb_dms_mld(:,:)  = 0.0  !! MLD 
     249      zn_dms_mld(:,:)  = 0.0 
     250      za_dms_mld(:,:)  = 0.0 
     251      zb_dms_qsr(:,:)  = 0.0  !! QSR 
     252      zn_dms_qsr(:,:)  = 0.0 
     253      za_dms_qsr(:,:)  = 0.0 
     254      zb_dms_din(:,:)  = 0.0  !! DIN 
     255      zn_dms_din(:,:)  = 0.0 
     256      za_dms_din(:,:)  = 0.0 
     257      !! 
     258      IF(lwp) WRITE(numout,*) ' trc_ini_medusa: average fields for DMS initialised to zero' 
     259      IF(lwp) CALL flush(numout) 
     260 
     261      !!---------------------------------------------------------------------- 
    234262      !! AXY (04/11/13): initialise fields previously done by trc_sed_medusa 
    235263      !!---------------------------------------------------------------------- 
    … …  
    302330      !! ------------- 
    303331      !! 
    304       IF(lwp) WRITE(numout,*) ' ' 
    305       IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd' 
    306       CALL iom_open ( 'ccd_ocal_nemo.nc', numccd ) 
    307       IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc opened' 
     332      !!!! JPALM -- 14-09-2015 --  
     333      !!!!       -- to test on ORCA2 with Christian, no file available, so initiate to 0  
     334      IF (ln_ccd) THEN 
     335         IF(lwp) WRITE(numout,*) ' ' 
     336         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd' 
     337         CALL iom_open ( 'ccd_ocal_nemo.nc', numccd ) 
     338         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc opened' 
    308339 
    309340      !! Read the data 
    310341      !! ------------- 
    311342      !! 
    312       CALL iom_get ( numccd, jpdom_data, 'OCAL_CCD', ocal_ccd ) 
    313       IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: data read' 
     343         CALL iom_get ( numccd, jpdom_data, 'OCAL_CCD', ocal_ccd ) 
     344         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: data read' 
    314345 
    315346      !! Close the file 
    316347      !! -------------- 
    317348      !! 
    318       CALL iom_close ( numccd ) 
    319       IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc closed' 
    320       IF(lwp) CALL flush(numout) 
    321        
     349         CALL iom_close ( numccd ) 
     350         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: ccd_ocal_nemo.nc closed' 
     351         IF(lwp) CALL flush(numout) 
     352      ELSE 
     353         IF(lwp) WRITE(numout,*) ' ' 
     354         IF(lwp) WRITE(numout,*) ' **** Routine trc_ini_medusa_ccd' 
     355         IF(lwp) WRITE(numout,*) ' **** trc_ini_medusa_ccd: do not read ccd_ocal_nemo.nc' 
     356         IF(lwp) WRITE(numout,*) ' **** ln_ccd = FALSE and ocal_ccd = 0.0 ---' 
     357         ocal_ccd(:,:) = 0.0   
     358      ENDIF 
     359  
    322360   END SUBROUTINE trc_ini_medusa_ccd 
    323361 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90

    r5726 r6639  
    2222   USE sms_medusa      ! sms trends 
    2323   USE iom             ! I/O manager 
     24   !!USE trc_nam_dia     ! JPALM 13-11-2015 -- if iom_use for diag 
    2425 
    2526   !! AXY (04/02/14): necessary to find NaNs on HECTOR 
    … …  
    2930   PRIVATE 
    3031 
    31    PUBLIC   trc_nam_medusa   ! called by trcnam.F90 module 
     32   PUBLIC   trc_nam_medusa       ! called by trcnam.F90 module 
     33   PUBLIC   trc_nam_iom_medusa   ! called by trcnam.F90 module 
    3234 
    3335   !!* Substitution 
    … …  
    8385      &  xsdiss,                                              & 
    8486      &  vsed,xhr,                                            & 
    85       &  sedlam,sedlostpoc,jpkb,jdms 
     87      &  sedlam,sedlostpoc,jpkb,jdms,jdms_input,jdms_model 
    8688#if defined key_roam 
    8789      NAMELIST/natroam/ xthetaphy,xthetazoo,xthetanit,        & 
    … …  
    138140     IF( ( .NOT.lk_iomput .AND. ln_diatrc ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN 
    139141         ! 
    140          ! Namelist nampisdia 
     142         ! Namelist nammeddia 
    141143         ! ------------------- 
    142          REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics 
     144         REWIND( numnatp_ref )              ! Namelist nammeddia in reference namelist : MEDUSA diagnostics 
    143145         READ  ( numnatp_ref, nammeddia, IOSTAT = ios, ERR = 901) 
    144146901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) 
    145147 
    146          REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics 
     148         REWIND( numnatp_cfg )              ! Namelist nammeddia in configuration namelist : MEDUSA diagnostics 
    147149         READ  ( numnatp_cfg, nammeddia, IOSTAT = ios, ERR = 902 ) 
    148150902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) 
    … …  
    338340      jpkb    = 0. 
    339341      jdms        = 0 
     342      jdms_input  = 0 
     343      jdms_input  = 3 
    340344             
    341345      !REWIND(numnatm) 
    … …  
    343347         ! Namelist natbio 
    344348         ! ------------------- 
    345          REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics 
    346          READ  ( numnatp_ref, natbio, IOSTAT = ios, ERR = 901) 
    347 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) 
    348  
    349          REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics 
    350          READ  ( numnatp_cfg, natbio, IOSTAT = ios, ERR = 902 ) 
    351 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) 
     349         REWIND( numnatp_ref )              ! Namelist natbio in reference namelist : MEDUSA diagnostics 
     350         READ  ( numnatp_ref, natbio, IOSTAT = ios, ERR = 903) 
     351903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natbio in reference namelist', lwp ) 
     352 
     353         REWIND( numnatp_cfg )              ! Namelist natbio in configuration namelist : MEDUSA diagnostics 
     354         READ  ( numnatp_cfg, natbio, IOSTAT = ios, ERR = 904 ) 
     355904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natbio in configuration namelist', lwp ) 
    352356         IF(lwm) WRITE ( numonp, natbio ) 
    353357 
    … …  
    488492!! UKESM1 - new diagnostics  !! Jpalm 
    489493!!       jdms        :  include dms diagnostics 
    490 !! 
    491 !! 
    492 !! 
    493  
     494!!  jdms_input  :  use instant (0) or diel-avg (1) inputs 
     495!!       jdms_model  :  choice of DMS model passed to atmosphere 
     496!!                      1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL 
     497!! 
    494498      IF(lwp) THEN 
    495499!! 
    … …  
    510514         &   ' key_axy_carbchem                                                       = INACTIVE' 
    511515#endif         
     516#if defined key_mocsy 
     517         WRITE(numout,*)     & 
     518         &   ' key_mocsy                                                              = ACTIVE' 
     519#else 
     520         WRITE(numout,*)     & 
     521         &   ' key_mocsy                                                              = INACTIVE' 
     522#endif         
     523#if defined key_avgqsr_medusa 
     524         WRITE(numout,*)     & 
     525         &   ' key_avgqsr_medusa                                                      = ACTIVE' 
     526#else 
     527         WRITE(numout,*)     & 
     528         &   ' key_avgqsr_medusa                                                      = INACTIVE' 
     529#endif         
    512530#if defined key_bs_axy_zforce 
    513531         WRITE(numout,*)     & 
    … …  
    544562         WRITE(numout,*)     & 
    545563         &   ' key_axy_pi_co2                                                         = INACTIVE' 
     564# endif 
     565# if defined key_debug_medusa 
     566         WRITE(numout,*)     & 
     567         &   ' key_debug_medusa                                                       = ACTIVE' 
     568#else 
     569         WRITE(numout,*)     & 
     570         &   ' key_debug_medusa                                                       = INACTIVE' 
    546571# endif 
    547572         WRITE(numout,*) ' ' 
    … …  
    971996         &   ' Vert layer for diagnostic of vertical flux,                jpkp        = ', jpkb 
    972997!! 
    973 !! UKESM1 - new diagnostics  !! Jpalm 
     998!! UKESM1 - new diagnostics  !! Jpalm; AXY (08/07/15) 
    974999         WRITE(numout,*) '=== UKESM1-related parameters' 
    9751000         WRITE(numout,*)     & 
    9761001         &   ' include DMS diagnostic?,                                   jdms        = ', jdms 
     1002         if (jdms_input .eq. 0) then 
     1003            WRITE(numout,*)     & 
     1004            &   ' use instant (0) or diel-avg (1) inputs,                    jdms_input  = instantaneous' 
     1005         else 
     1006            WRITE(numout,*)     & 
     1007            &   ' use instant (0) or diel-avg (1) inputs,                    jdms_input  = diel-average' 
     1008         endif 
     1009    if (jdms_model .eq. 1) then 
     1010            WRITE(numout,*)     & 
     1011            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Anderson et al. (2001)' 
     1012    elseif (jdms_model .eq. 2) then 
     1013            WRITE(numout,*)     & 
     1014            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Simo & Dachs (2002)' 
     1015    elseif (jdms_model .eq. 3) then 
     1016            WRITE(numout,*)     & 
     1017            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Aranami & Tsunogai (2004)' 
     1018    elseif (jdms_model .eq. 4) then 
     1019            WRITE(numout,*)     & 
     1020            &   ' choice of DMS model passed to atmosphere,                  jdms_model  = Halloran et al. (2010)' 
     1021         endif 
    9771022!! 
    9781023      ENDIF 
    … …  
    10321077 
    10331078      !READ(numnatm,natroam) 
    1034          ! Namelist natbio 
     1079         ! Namelist natroam 
    10351080         ! ------------------- 
    1036          REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics 
    1037          READ  ( numnatp_ref, natbio, IOSTAT = ios, ERR = 901) 
    1038 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) 
    1039  
    1040          REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics 
    1041          READ  ( numnatp_cfg, natbio, IOSTAT = ios, ERR = 902 ) 
    1042 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) 
    1043          IF(lwm) WRITE ( numonp, natbio ) 
     1081         REWIND( numnatp_ref )              ! Namelist natroam in reference namelist : MEDUSA diagnostics 
     1082         READ  ( numnatp_ref, natroam, IOSTAT = ios, ERR = 905) 
     1083905      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natroam in reference namelist', lwp ) 
     1084 
     1085         REWIND( numnatp_cfg )              ! Namelist natroam in configuration namelist : MEDUSA diagnostics 
     1086         READ  ( numnatp_cfg, natroam, IOSTAT = ios, ERR = 906 ) 
     1087906      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natroam in configuration namelist', lwp ) 
     1088         IF(lwm) WRITE ( numonp, natroam ) 
    10441089 
    10451090!! ROAM carbon, alkalinity and oxygen cycle parameters 
    … …  
    10861131         ! Namelist natopt 
    10871132         ! ------------------- 
    1088          REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics 
    1089          READ  ( numnatp_ref, natopt, IOSTAT = ios, ERR = 901) 
    1090 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) 
    1091  
    1092          REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics 
    1093          READ  ( numnatp_cfg, natopt, IOSTAT = ios, ERR = 902 ) 
    1094 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) 
     1133         REWIND( numnatp_ref )              ! Namelist natopt in reference namelist : MEDUSA diagnostics 
     1134         READ  ( numnatp_ref, natopt, IOSTAT = ios, ERR = 907) 
     1135907      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natopt in reference namelist', lwp ) 
     1136 
     1137         REWIND( numnatp_cfg )              ! Namelist natopt in configuration namelist : MEDUSA diagnostics 
     1138         READ  ( numnatp_cfg, natopt, IOSTAT = ios, ERR = 908 ) 
     1139908      IF( ios /= 0 ) CALL ctl_nam ( ios , 'natopt in configuration namelist', lwp ) 
    10951140         IF(lwm) WRITE ( numonp, natopt ) 
    10961141 
    … …  
    11261171   END SUBROUTINE trc_nam_medusa 
    11271172    
     1173   SUBROUTINE trc_nam_iom_medusa 
     1174    !!--------------------------------------------------------------------- 
     1175      !!                     ***  ROUTINE trc_nam_iom_medusa  *** 
     1176      !! 
     1177      !! ** Purpose : read all diag requested in iodef file through iom_use 
     1178      !!              So it is done only once  
     1179      !!            ** All diagnostic MEDUSA could asked are registered in 
     1180      !!            the med_diag type with a boolean value 
     1181      !!            So if required, one diagnostic will be true. 
     1182      !! 
     1183      !!--------------------------------------------------------------------- 
     1184      !! 
     1185      !! 
     1186      !!----------------------------------------------------------------------             
     1187      !! Variable conventions 
     1188      !!---------------------------------------------------------------------- 
     1189      !! 
     1190      IF (iom_use("INVTN")) THEN  
     1191          med_diag%INVTN%dgsave = .TRUE. 
     1192      ELSE  
     1193          med_diag%INVTN%dgsave = .FALSE. 
     1194      ENDIF 
     1195      IF  (iom_use("INVTSI")) THEN  
     1196          med_diag%INVTSI%dgsave = .TRUE. 
     1197      ELSE  
     1198          med_diag%INVTSI%dgsave = .FALSE. 
     1199      ENDIF 
     1200      IF  (iom_use("INVTFE")) THEN  
     1201          med_diag%INVTFE%dgsave = .TRUE. 
     1202      ELSE  
     1203          med_diag%INVTFE%dgsave = .FALSE. 
     1204      ENDIF 
     1205      IF  (iom_use("PRN")) THEN  
     1206          med_diag%PRN%dgsave = .TRUE. 
     1207      ELSE  
     1208          med_diag%PRN%dgsave = .FALSE. 
     1209      ENDIF 
     1210      IF  (iom_use("MPN")) THEN  
     1211          med_diag%MPN%dgsave = .TRUE. 
     1212      ELSE  
     1213          med_diag%MPN%dgsave = .FALSE. 
     1214      ENDIF 
     1215      IF  (iom_use("PRD")) THEN  
     1216          med_diag%PRD%dgsave = .TRUE. 
     1217      ELSE  
     1218          med_diag%PRD%dgsave = .FALSE. 
     1219      ENDIF 
     1220      IF  (iom_use("MPD")) THEN  
     1221          med_diag%MPD%dgsave = .TRUE. 
     1222      ELSE  
     1223          med_diag%MPD%dgsave = .FALSE. 
     1224      ENDIF 
     1225      IF  (iom_use("DSED")) THEN  
     1226          med_diag%DSED%dgsave = .TRUE. 
     1227      ELSE  
     1228          med_diag%DSED%dgsave = .FALSE. 
     1229      ENDIF 
     1230      IF  (iom_use("OPAL")) THEN  
     1231          med_diag%OPAL%dgsave = .TRUE. 
     1232      ELSE  
     1233          med_diag%OPAL%dgsave = .FALSE. 
     1234      ENDIF 
     1235      IF  (iom_use("OPALDISS")) THEN  
     1236          med_diag%OPALDISS%dgsave = .TRUE. 
     1237      ELSE  
     1238          med_diag%OPALDISS%dgsave = .FALSE. 
     1239      ENDIF 
     1240      IF  (iom_use("GMIPn")) THEN  
     1241          med_diag%GMIPn%dgsave = .TRUE. 
     1242      ELSE  
     1243          med_diag%GMIPn%dgsave = .FALSE. 
     1244      ENDIF 
     1245      IF  (iom_use("GMID")) THEN  
     1246          med_diag%GMID%dgsave = .TRUE. 
     1247      ELSE  
     1248          med_diag%GMID%dgsave = .FALSE. 
     1249      ENDIF 
     1250      IF  (iom_use("MZMI")) THEN  
     1251          med_diag%MZMI%dgsave = .TRUE. 
     1252      ELSE  
     1253          med_diag%MZMI%dgsave = .FALSE. 
     1254      ENDIF 
     1255      IF  (iom_use("GMEPN")) THEN  
     1256          med_diag%GMEPN%dgsave = .TRUE. 
     1257      ELSE  
     1258          med_diag%GMEPN%dgsave = .FALSE. 
     1259      ENDIF 
     1260      IF  (iom_use("GMEPD")) THEN  
     1261          med_diag%GMEPD%dgsave = .TRUE. 
     1262      ELSE  
     1263          med_diag%GMEPD%dgsave = .FALSE. 
     1264      ENDIF 
     1265      IF  (iom_use("GMEZMI")) THEN  
     1266          med_diag%GMEZMI%dgsave = .TRUE. 
     1267      ELSE  
     1268          med_diag%GMEZMI%dgsave = .FALSE. 
     1269      ENDIF 
     1270      IF  (iom_use("GMED")) THEN  
     1271          med_diag%GMED%dgsave = .TRUE. 
     1272      ELSE  
     1273          med_diag%GMED%dgsave = .FALSE. 
     1274      ENDIF 
     1275      IF  (iom_use("MZME")) THEN  
     1276          med_diag%MZME%dgsave = .TRUE. 
     1277      ELSE  
     1278          med_diag%MZME%dgsave = .FALSE. 
     1279      ENDIF 
     1280      IF  (iom_use("DEXP")) THEN  
     1281          med_diag%DEXP%dgsave = .TRUE. 
     1282      ELSE  
     1283          med_diag%DEXP%dgsave = .FALSE. 
     1284      ENDIF 
     1285      IF  (iom_use("DETN")) THEN  
     1286          med_diag%DETN%dgsave = .TRUE. 
     1287      ELSE  
     1288          med_diag%DETN%dgsave = .FALSE. 
     1289      ENDIF 
     1290      IF  (iom_use("MDET")) THEN  
     1291          med_diag%MDET%dgsave = .TRUE. 
     1292      ELSE  
     1293          med_diag%MDET%dgsave = .FALSE. 
     1294      ENDIF 
     1295      IF  (iom_use("AEOLIAN")) THEN  
     1296          med_diag%AEOLIAN%dgsave = .TRUE. 
     1297      ELSE  
     1298          med_diag%AEOLIAN%dgsave = .FALSE. 
     1299      ENDIF 
     1300      IF  (iom_use("BENTHIC")) THEN  
     1301          med_diag%BENTHIC%dgsave = .TRUE. 
     1302      ELSE  
     1303          med_diag%BENTHIC%dgsave = .FALSE. 
     1304      ENDIF 
     1305      IF  (iom_use("SCAVENGE")) THEN  
     1306          med_diag%SCAVENGE%dgsave = .TRUE. 
     1307      ELSE  
     1308          med_diag%SCAVENGE%dgsave = .FALSE. 
     1309      ENDIF 
     1310      IF  (iom_use("PN_JLIM")) THEN  
     1311          med_diag%PN_JLIM%dgsave = .TRUE. 
     1312      ELSE  
     1313          med_diag%PN_JLIM%dgsave = .FALSE. 
     1314      ENDIF 
     1315      IF  (iom_use("PN_NLIM")) THEN  
     1316          med_diag%PN_NLIM%dgsave = .TRUE. 
     1317      ELSE  
     1318          med_diag%PN_NLIM%dgsave = .FALSE. 
     1319      ENDIF 
     1320      IF  (iom_use("PN_FELIM")) THEN  
     1321          med_diag%PN_FELIM%dgsave = .TRUE. 
     1322      ELSE  
     1323          med_diag%PN_FELIM%dgsave = .FALSE. 
     1324      ENDIF 
     1325      IF  (iom_use("PD_JLIM")) THEN  
     1326          med_diag%PD_JLIM%dgsave = .TRUE. 
     1327      ELSE  
     1328          med_diag%PD_JLIM%dgsave = .FALSE. 
     1329      ENDIF 
     1330      IF  (iom_use("PD_NLIM")) THEN  
     1331          med_diag%PD_NLIM%dgsave = .TRUE. 
     1332      ELSE  
     1333          med_diag%PD_NLIM%dgsave = .FALSE. 
     1334      ENDIF 
     1335      IF  (iom_use("PD_FELIM")) THEN  
     1336          med_diag%PD_FELIM%dgsave = .TRUE. 
     1337      ELSE  
     1338          med_diag%PD_FELIM%dgsave = .FALSE. 
     1339      ENDIF 
     1340      IF  (iom_use("PD_SILIM")) THEN  
     1341          med_diag%PD_SILIM%dgsave = .TRUE. 
     1342      ELSE  
     1343          med_diag%PD_SILIM%dgsave = .FALSE. 
     1344      ENDIF 
     1345      IF  (iom_use("PDSILIM2")) THEN  
     1346          med_diag%PDSILIM2%dgsave = .TRUE. 
     1347      ELSE  
     1348          med_diag%PDSILIM2%dgsave = .FALSE. 
     1349      ENDIF 
     1350      IF  (iom_use("SDT__100")) THEN  
     1351          med_diag%SDT__100%dgsave = .TRUE. 
     1352      ELSE  
     1353          med_diag%SDT__100%dgsave = .FALSE. 
     1354      ENDIF 
     1355      IF  (iom_use("SDT__200")) THEN  
     1356          med_diag%SDT__200%dgsave = .TRUE. 
     1357      ELSE  
     1358          med_diag%SDT__200%dgsave = .FALSE. 
     1359      ENDIF 
     1360      IF  (iom_use("SDT__500")) THEN  
     1361          med_diag%SDT__500%dgsave = .TRUE. 
     1362      ELSE  
     1363          med_diag%SDT__500%dgsave = .FALSE. 
     1364      ENDIF 
     1365      IF  (iom_use("SDT_1000")) THEN  
     1366          med_diag%SDT_1000%dgsave = .TRUE. 
     1367      ELSE  
     1368          med_diag%SDT_1000%dgsave = .FALSE. 
     1369      ENDIF 
     1370      IF  (iom_use("TOTREG_N")) THEN  
     1371          med_diag%TOTREG_N%dgsave = .TRUE. 
     1372      ELSE  
     1373          med_diag%TOTREG_N%dgsave = .FALSE. 
     1374      ENDIF 
     1375      IF  (iom_use("TOTRG_SI")) THEN  
     1376          med_diag%TOTRG_SI%dgsave = .TRUE. 
     1377      ELSE  
     1378          med_diag%TOTRG_SI%dgsave = .FALSE. 
     1379      ENDIF 
     1380      IF  (iom_use("REG__100")) THEN  
     1381          med_diag%REG__100%dgsave = .TRUE. 
     1382      ELSE  
     1383          med_diag%REG__100%dgsave = .FALSE. 
     1384      ENDIF 
     1385      IF  (iom_use("REG__200")) THEN  
     1386          med_diag%REG__200%dgsave = .TRUE. 
     1387      ELSE  
     1388          med_diag%REG__200%dgsave = .FALSE. 
     1389      ENDIF 
     1390      IF  (iom_use("REG__500")) THEN  
     1391          med_diag%REG__500%dgsave = .TRUE. 
     1392      ELSE  
     1393          med_diag%REG__500%dgsave = .FALSE. 
     1394      ENDIF 
     1395      IF  (iom_use("REG_1000")) THEN  
     1396          med_diag%REG_1000%dgsave = .TRUE. 
     1397      ELSE  
     1398          med_diag%REG_1000%dgsave = .FALSE. 
     1399      ENDIF 
     1400      IF  (iom_use("FASTN")) THEN  
     1401          med_diag%FASTN%dgsave = .TRUE. 
     1402      ELSE  
     1403          med_diag%FASTN%dgsave = .FALSE. 
     1404      ENDIF 
     1405      IF  (iom_use("FASTSI")) THEN  
     1406          med_diag%FASTSI%dgsave = .TRUE. 
     1407      ELSE  
     1408          med_diag%FASTSI%dgsave = .FALSE. 
     1409      ENDIF 
     1410      IF  (iom_use("FASTFE")) THEN  
     1411          med_diag%FASTFE%dgsave = .TRUE. 
     1412      ELSE  
     1413          med_diag%FASTFE%dgsave = .FALSE. 
     1414      ENDIF 
     1415      IF  (iom_use("FASTC")) THEN  
     1416          med_diag%FASTC%dgsave = .TRUE. 
     1417      ELSE  
     1418          med_diag%FASTC%dgsave = .FALSE. 
     1419      ENDIF 
     1420      IF  (iom_use("FASTCA")) THEN  
     1421          med_diag%FASTCA%dgsave = .TRUE. 
     1422      ELSE  
     1423          med_diag%FASTCA%dgsave = .FALSE. 
     1424      ENDIF 
     1425      IF  (iom_use("FDT__100")) THEN  
     1426          med_diag%FDT__100%dgsave = .TRUE. 
     1427      ELSE  
     1428          med_diag%FDT__100%dgsave = .FALSE. 
     1429      ENDIF 
     1430      IF  (iom_use("FDT__200")) THEN  
     1431          med_diag%FDT__200%dgsave = .TRUE. 
     1432      ELSE  
     1433          med_diag%FDT__200%dgsave = .FALSE. 
     1434      ENDIF 
     1435      IF  (iom_use("FDT__500")) THEN  
     1436          med_diag%FDT__500%dgsave = .TRUE. 
     1437      ELSE  
     1438          med_diag%FDT__500%dgsave = .FALSE. 
     1439      ENDIF 
     1440      IF  (iom_use("FDT_1000")) THEN  
     1441          med_diag%FDT_1000%dgsave = .TRUE. 
     1442      ELSE  
     1443          med_diag%FDT_1000%dgsave = .FALSE. 
     1444      ENDIF 
     1445      IF  (iom_use("RG__100F")) THEN  
     1446          med_diag%RG__100F%dgsave = .TRUE. 
     1447      ELSE  
     1448          med_diag%RG__100F%dgsave = .FALSE. 
     1449      ENDIF 
     1450      IF  (iom_use("RG__200F")) THEN  
     1451          med_diag%RG__200F%dgsave = .TRUE. 
     1452      ELSE  
     1453          med_diag%RG__200F%dgsave = .FALSE. 
     1454      ENDIF 
     1455      IF  (iom_use("RG__500F")) THEN  
     1456          med_diag%RG__500F%dgsave = .TRUE. 
     1457      ELSE  
     1458          med_diag%RG__500F%dgsave = .FALSE. 
     1459      ENDIF 
     1460      IF  (iom_use("RG_1000F")) THEN  
     1461          med_diag%RG_1000F%dgsave = .TRUE. 
     1462      ELSE  
     1463          med_diag%RG_1000F%dgsave = .FALSE. 
     1464      ENDIF 
     1465      IF  (iom_use("FDS__100")) THEN  
     1466          med_diag%FDS__100%dgsave = .TRUE. 
     1467      ELSE  
     1468          med_diag%FDS__100%dgsave = .FALSE. 
     1469      ENDIF 
     1470      IF  (iom_use("FDS__200")) THEN  
     1471          med_diag%FDS__200%dgsave = .TRUE. 
     1472      ELSE  
     1473          med_diag%FDS__200%dgsave = .FALSE. 
     1474      ENDIF 
     1475      IF  (iom_use("FDS__500")) THEN  
     1476          med_diag%FDS__500%dgsave = .TRUE. 
     1477      ELSE  
     1478          med_diag%FDS__500%dgsave = .FALSE. 
     1479      ENDIF 
     1480      IF  (iom_use("FDS_1000")) THEN  
     1481          med_diag%FDS_1000%dgsave = .TRUE. 
     1482      ELSE  
     1483          med_diag%FDS_1000%dgsave = .FALSE. 
     1484      ENDIF 
     1485      IF  (iom_use("RGS_100F")) THEN  
     1486          med_diag%RGS_100F%dgsave = .TRUE. 
     1487      ELSE  
     1488          med_diag%RGS_100F%dgsave = .FALSE. 
     1489      ENDIF 
     1490      IF  (iom_use("RGS_200F")) THEN  
     1491          med_diag%RGS_200F%dgsave = .TRUE. 
     1492      ELSE  
     1493          med_diag%RGS_200F%dgsave = .FALSE. 
     1494      ENDIF 
     1495      IF  (iom_use("RGS_500F")) THEN  
     1496          med_diag%RGS_500F%dgsave = .TRUE. 
     1497      ELSE  
     1498          med_diag%RGS_500F%dgsave = .FALSE. 
     1499      ENDIF 
     1500      IF  (iom_use("RGS1000F")) THEN  
     1501          med_diag%RGS1000F%dgsave = .TRUE. 
     1502      ELSE  
     1503          med_diag%RGS1000F%dgsave = .FALSE. 
     1504      ENDIF 
     1505      IF  (iom_use("REMINN")) THEN  
     1506          med_diag%REMINN%dgsave = .TRUE. 
     1507      ELSE  
     1508          med_diag%REMINN%dgsave = .FALSE. 
     1509      ENDIF 
     1510      IF  (iom_use("REMINSI")) THEN  
     1511          med_diag%REMINSI%dgsave = .TRUE. 
     1512      ELSE  
     1513          med_diag%REMINSI%dgsave = .FALSE. 
     1514      ENDIF 
     1515      IF  (iom_use("REMINFE")) THEN  
     1516          med_diag%REMINFE%dgsave = .TRUE. 
     1517      ELSE  
     1518          med_diag%REMINFE%dgsave = .FALSE. 
     1519      ENDIF 
     1520      IF  (iom_use("REMINC")) THEN  
     1521          med_diag%REMINC%dgsave = .TRUE. 
     1522      ELSE  
     1523          med_diag%REMINC%dgsave = .FALSE. 
     1524      ENDIF 
     1525      IF  (iom_use("REMINCA")) THEN  
     1526          med_diag%REMINCA%dgsave = .TRUE. 
     1527      ELSE  
     1528          med_diag%REMINCA%dgsave = .FALSE. 
     1529      ENDIF 
     1530      IF  (iom_use("SEAFLRN")) THEN  
     1531          med_diag%SEAFLRN%dgsave = .TRUE. 
     1532      ELSE  
     1533          med_diag%SEAFLRN%dgsave = .FALSE. 
     1534      ENDIF 
     1535      IF  (iom_use("SEAFLRSI")) THEN  
     1536          med_diag%SEAFLRSI%dgsave = .TRUE. 
     1537      ELSE  
     1538          med_diag%SEAFLRSI%dgsave = .FALSE. 
     1539      ENDIF 
     1540      IF  (iom_use("SEAFLRFE")) THEN  
     1541          med_diag%SEAFLRFE%dgsave = .TRUE. 
     1542      ELSE  
     1543          med_diag%SEAFLRFE%dgsave = .FALSE. 
     1544      ENDIF 
     1545      IF  (iom_use("SEAFLRC")) THEN  
     1546          med_diag%SEAFLRC%dgsave = .TRUE. 
     1547      ELSE  
     1548          med_diag%SEAFLRC%dgsave = .FALSE. 
     1549      ENDIF 
     1550      IF  (iom_use("SEAFLRCA")) THEN  
     1551          med_diag%SEAFLRCA%dgsave = .TRUE. 
     1552      ELSE  
     1553          med_diag%SEAFLRCA%dgsave = .FALSE. 
     1554      ENDIF 
     1555      IF  (iom_use("MED_QSR")) THEN  
     1556          med_diag%MED_QSR%dgsave = .TRUE. 
     1557      ELSE  
     1558          med_diag%MED_QSR%dgsave = .FALSE. 
     1559      ENDIF 
     1560      IF  (iom_use("MED_XPAR")) THEN  
     1561          med_diag%MED_XPAR%dgsave = .TRUE. 
     1562      ELSE  
     1563          med_diag%MED_XPAR%dgsave = .FALSE. 
     1564      ENDIF 
     1565      IF  (iom_use("INTFLX_N")) THEN  
     1566          med_diag%INTFLX_N%dgsave = .TRUE. 
     1567      ELSE  
     1568          med_diag%INTFLX_N%dgsave = .FALSE. 
     1569      ENDIF 
     1570      IF  (iom_use("INTFLX_SI")) THEN  
     1571          med_diag%INTFLX_SI%dgsave = .TRUE. 
     1572      ELSE  
     1573          med_diag%INTFLX_SI%dgsave = .FALSE. 
     1574      ENDIF 
     1575      IF  (iom_use("INTFLX_FE")) THEN  
     1576          med_diag%INTFLX_FE%dgsave = .TRUE. 
     1577      ELSE  
     1578          med_diag%INTFLX_FE%dgsave = .FALSE. 
     1579      ENDIF 
     1580      IF  (iom_use("INT_PN")) THEN  
     1581          med_diag%INT_PN%dgsave = .TRUE. 
     1582      ELSE  
     1583          med_diag%INT_PN%dgsave = .FALSE. 
     1584      ENDIF 
     1585      IF  (iom_use("INT_PD")) THEN  
     1586          med_diag%INT_PD%dgsave = .TRUE. 
     1587      ELSE  
     1588          med_diag%INT_PD%dgsave = .FALSE. 
     1589      ENDIF 
     1590      IF  (iom_use("ML_PRN")) THEN  
     1591          med_diag%ML_PRN%dgsave = .TRUE. 
     1592      ELSE  
     1593          med_diag%ML_PRN%dgsave = .FALSE. 
     1594      ENDIF 
     1595      IF  (iom_use("ML_PRD")) THEN  
     1596          med_diag%ML_PRD%dgsave = .TRUE. 
     1597      ELSE  
     1598          med_diag%ML_PRD%dgsave = .FALSE. 
     1599      ENDIF 
     1600      IF  (iom_use("OCAL_CCD")) THEN  
     1601          med_diag%OCAL_CCD%dgsave = .TRUE. 
     1602      ELSE  
     1603          med_diag%OCAL_CCD%dgsave = .FALSE. 
     1604      ENDIF 
     1605      IF  (iom_use("OCAL_LVL")) THEN  
     1606          med_diag%OCAL_LVL%dgsave = .TRUE. 
     1607      ELSE  
     1608          med_diag%OCAL_LVL%dgsave = .FALSE. 
     1609      ENDIF 
     1610      IF  (iom_use("FE_0000")) THEN  
     1611          med_diag%FE_0000%dgsave = .TRUE. 
     1612      ELSE  
     1613          med_diag%FE_0000%dgsave = .FALSE. 
     1614      ENDIF 
     1615      IF  (iom_use("FE_0100")) THEN  
     1616          med_diag%FE_0100%dgsave = .TRUE. 
     1617      ELSE  
     1618          med_diag%FE_0100%dgsave = .FALSE. 
     1619      ENDIF 
     1620      IF  (iom_use("FE_0200")) THEN  
     1621          med_diag%FE_0200%dgsave = .TRUE. 
     1622      ELSE  
     1623          med_diag%FE_0200%dgsave = .FALSE. 
     1624      ENDIF 
     1625      IF  (iom_use("FE_0500")) THEN  
     1626          med_diag%FE_0500%dgsave = .TRUE. 
     1627      ELSE  
     1628          med_diag%FE_0500%dgsave = .FALSE. 
     1629      ENDIF 
     1630      IF  (iom_use("FE_1000")) THEN  
     1631          med_diag%FE_1000%dgsave = .TRUE. 
     1632      ELSE  
     1633          med_diag%FE_1000%dgsave = .FALSE. 
     1634      ENDIF 
     1635      IF  (iom_use("MED_XZE")) THEN  
     1636          med_diag%MED_XZE%dgsave = .TRUE. 
     1637      ELSE  
     1638          med_diag%MED_XZE%dgsave = .FALSE. 
     1639      ENDIF 
     1640      IF  (iom_use("WIND")) THEN  
     1641          med_diag%WIND%dgsave = .TRUE. 
     1642      ELSE  
     1643          med_diag%WIND%dgsave = .FALSE. 
     1644      ENDIF 
     1645      IF  (iom_use("ATM_PCO2")) THEN  
     1646          med_diag%ATM_PCO2%dgsave = .TRUE. 
     1647      ELSE  
     1648          med_diag%ATM_PCO2%dgsave = .FALSE. 
     1649      ENDIF 
     1650      IF  (iom_use("OCN_PH")) THEN  
     1651          med_diag%OCN_PH%dgsave = .TRUE. 
     1652      ELSE  
     1653          med_diag%OCN_PH%dgsave = .FALSE. 
     1654      ENDIF 
     1655      IF  (iom_use("OCN_PCO2")) THEN  
     1656          med_diag%OCN_PCO2%dgsave = .TRUE. 
     1657      ELSE  
     1658          med_diag%OCN_PCO2%dgsave = .FALSE. 
     1659      ENDIF 
     1660      IF  (iom_use("OCNH2CO3")) THEN  
     1661          med_diag%OCNH2CO3%dgsave = .TRUE. 
     1662      ELSE  
     1663          med_diag%OCNH2CO3%dgsave = .FALSE. 
     1664      ENDIF 
     1665      IF  (iom_use("OCN_HCO3")) THEN  
     1666          med_diag%OCN_HCO3%dgsave = .TRUE. 
     1667      ELSE  
     1668          med_diag%OCN_HCO3%dgsave = .FALSE. 
     1669      ENDIF 
     1670      IF  (iom_use("OCN_CO3")) THEN  
     1671          med_diag%OCN_CO3%dgsave = .TRUE. 
     1672      ELSE  
     1673          med_diag%OCN_CO3%dgsave = .FALSE. 
     1674      ENDIF 
     1675      IF  (iom_use("CO2FLUX")) THEN  
     1676          med_diag%CO2FLUX%dgsave = .TRUE. 
     1677      ELSE  
     1678          med_diag%CO2FLUX%dgsave = .FALSE. 
     1679      ENDIF 
     1680      IF  (iom_use("OM_CAL")) THEN  
     1681          med_diag%OM_CAL%dgsave = .TRUE. 
     1682      ELSE  
     1683          med_diag%OM_CAL%dgsave = .FALSE. 
     1684      ENDIF 
     1685      IF  (iom_use("OM_ARG")) THEN  
     1686          med_diag%OM_ARG%dgsave = .TRUE. 
     1687      ELSE  
     1688          med_diag%OM_ARG%dgsave = .FALSE. 
     1689      ENDIF 
     1690      IF  (iom_use("TCO2")) THEN  
     1691          med_diag%TCO2%dgsave = .TRUE. 
     1692      ELSE  
     1693          med_diag%TCO2%dgsave = .FALSE. 
     1694      ENDIF 
     1695      IF  (iom_use("TALK")) THEN  
     1696          med_diag%TALK%dgsave = .TRUE. 
     1697      ELSE  
     1698          med_diag%TALK%dgsave = .FALSE. 
     1699      ENDIF 
     1700      IF  (iom_use("KW660")) THEN  
     1701          med_diag%KW660%dgsave = .TRUE. 
     1702      ELSE  
     1703          med_diag%KW660%dgsave = .FALSE. 
     1704      ENDIF 
     1705      IF  (iom_use("ATM_PP0")) THEN  
     1706          med_diag%ATM_PP0%dgsave = .TRUE. 
     1707      ELSE  
     1708          med_diag%ATM_PP0%dgsave = .FALSE. 
     1709      ENDIF 
     1710      IF  (iom_use("O2FLUX")) THEN  
     1711          med_diag%O2FLUX%dgsave = .TRUE. 
     1712      ELSE  
     1713          med_diag%O2FLUX%dgsave = .FALSE. 
     1714      ENDIF 
     1715      IF  (iom_use("O2SAT")) THEN  
     1716          med_diag%O2SAT%dgsave = .TRUE. 
     1717      ELSE  
     1718          med_diag%O2SAT%dgsave = .FALSE. 
     1719      ENDIF 
     1720      IF  (iom_use("CAL_CCD")) THEN  
     1721          med_diag%CAL_CCD%dgsave = .TRUE. 
     1722      ELSE  
     1723          med_diag%CAL_CCD%dgsave = .FALSE. 
     1724      ENDIF 
     1725      IF  (iom_use("ARG_CCD")) THEN  
     1726          med_diag%ARG_CCD%dgsave = .TRUE. 
     1727      ELSE  
     1728          med_diag%ARG_CCD%dgsave = .FALSE. 
     1729      ENDIF 
     1730      IF  (iom_use("SFR_OCAL")) THEN  
     1731          med_diag%SFR_OCAL%dgsave = .TRUE. 
     1732      ELSE  
     1733          med_diag%SFR_OCAL%dgsave = .FALSE. 
     1734      ENDIF 
     1735      IF  (iom_use("SFR_OARG")) THEN  
     1736          med_diag%SFR_OARG%dgsave = .TRUE. 
     1737      ELSE  
     1738          med_diag%SFR_OARG%dgsave = .FALSE. 
     1739      ENDIF 
     1740      IF  (iom_use("N_PROD")) THEN  
     1741          med_diag%N_PROD%dgsave = .TRUE. 
     1742      ELSE  
     1743          med_diag%N_PROD%dgsave = .FALSE. 
     1744      ENDIF 
     1745      IF  (iom_use("N_CONS")) THEN  
     1746          med_diag%N_CONS%dgsave = .TRUE. 
     1747      ELSE  
     1748          med_diag%N_CONS%dgsave = .FALSE. 
     1749      ENDIF 
     1750      IF  (iom_use("C_PROD")) THEN  
     1751          med_diag%C_PROD%dgsave = .TRUE. 
     1752      ELSE  
     1753          med_diag%C_PROD%dgsave = .FALSE. 
     1754      ENDIF 
     1755      IF  (iom_use("C_CONS")) THEN  
     1756          med_diag%C_CONS%dgsave = .TRUE. 
     1757      ELSE  
     1758          med_diag%C_CONS%dgsave = .FALSE. 
     1759      ENDIF 
     1760      IF  (iom_use("O2_PROD")) THEN  
     1761          med_diag%O2_PROD%dgsave = .TRUE. 
     1762      ELSE  
     1763          med_diag%O2_PROD%dgsave = .FALSE. 
     1764      ENDIF 
     1765      IF  (iom_use("O2_CONS")) THEN  
     1766          med_diag%O2_CONS%dgsave = .TRUE. 
     1767      ELSE  
     1768          med_diag%O2_CONS%dgsave = .FALSE. 
     1769      ENDIF 
     1770      IF  (iom_use("O2_ANOX")) THEN  
     1771          med_diag%O2_ANOX%dgsave = .TRUE. 
     1772      ELSE  
     1773          med_diag%O2_ANOX%dgsave = .FALSE. 
     1774      ENDIF 
     1775      IF  (iom_use("RR_0100")) THEN  
     1776          med_diag%RR_0100%dgsave = .TRUE. 
     1777      ELSE  
     1778          med_diag%RR_0100%dgsave = .FALSE. 
     1779      ENDIF 
     1780      IF  (iom_use("RR_0500")) THEN  
     1781          med_diag%RR_0500%dgsave = .TRUE. 
     1782      ELSE  
     1783          med_diag%RR_0500%dgsave = .FALSE. 
     1784      ENDIF 
     1785      IF  (iom_use("RR_1000")) THEN  
     1786          med_diag%RR_1000%dgsave = .TRUE. 
     1787      ELSE  
     1788          med_diag%RR_1000%dgsave = .FALSE. 
     1789      ENDIF 
     1790      IF  (iom_use("IBEN_N")) THEN  
     1791          med_diag%IBEN_N%dgsave = .TRUE. 
     1792      ELSE  
     1793          med_diag%IBEN_N%dgsave = .FALSE. 
     1794      ENDIF 
     1795      IF  (iom_use("IBEN_FE")) THEN  
     1796          med_diag%IBEN_FE%dgsave = .TRUE. 
     1797      ELSE  
     1798          med_diag%IBEN_FE%dgsave = .FALSE. 
     1799      ENDIF 
     1800      IF  (iom_use("IBEN_C")) THEN  
     1801          med_diag%IBEN_C%dgsave = .TRUE. 
     1802      ELSE  
     1803          med_diag%IBEN_C%dgsave = .FALSE. 
     1804      ENDIF 
     1805      IF  (iom_use("IBEN_SI")) THEN  
     1806          med_diag%IBEN_SI%dgsave = .TRUE. 
     1807      ELSE  
     1808          med_diag%IBEN_SI%dgsave = .FALSE. 
     1809      ENDIF 
     1810      IF  (iom_use("IBEN_CA")) THEN  
     1811          med_diag%IBEN_CA%dgsave = .TRUE. 
     1812      ELSE  
     1813          med_diag%IBEN_CA%dgsave = .FALSE. 
     1814      ENDIF 
     1815      IF  (iom_use("OBEN_N")) THEN  
     1816          med_diag%OBEN_N%dgsave = .TRUE. 
     1817      ELSE  
     1818          med_diag%OBEN_N%dgsave = .FALSE. 
     1819      ENDIF 
     1820      IF  (iom_use("OBEN_FE")) THEN  
     1821          med_diag%OBEN_FE%dgsave = .TRUE. 
     1822      ELSE  
     1823          med_diag%OBEN_FE%dgsave = .FALSE. 
     1824      ENDIF 
     1825      IF  (iom_use("OBEN_C")) THEN  
     1826          med_diag%OBEN_C%dgsave = .TRUE. 
     1827      ELSE  
     1828          med_diag%OBEN_C%dgsave = .FALSE. 
     1829      ENDIF 
     1830      IF  (iom_use("OBEN_SI")) THEN  
     1831          med_diag%OBEN_SI%dgsave = .TRUE. 
     1832      ELSE  
     1833          med_diag%OBEN_SI%dgsave = .FALSE. 
     1834      ENDIF 
     1835      IF  (iom_use("OBEN_CA")) THEN  
     1836          med_diag%OBEN_CA%dgsave = .TRUE. 
     1837      ELSE  
     1838          med_diag%OBEN_CA%dgsave = .FALSE. 
     1839      ENDIF 
     1840      IF  (iom_use("BEN_N")) THEN  
     1841          med_diag%BEN_N%dgsave = .TRUE. 
     1842      ELSE  
     1843          med_diag%BEN_N%dgsave = .FALSE. 
     1844      ENDIF 
     1845      IF  (iom_use("BEN_FE")) THEN  
     1846          med_diag%BEN_FE%dgsave = .TRUE. 
     1847      ELSE  
     1848          med_diag%BEN_FE%dgsave = .FALSE. 
     1849      ENDIF 
     1850      IF  (iom_use("BEN_C")) THEN  
     1851          med_diag%BEN_C%dgsave = .TRUE. 
     1852      ELSE  
     1853          med_diag%BEN_C%dgsave = .FALSE. 
     1854      ENDIF 
     1855      IF  (iom_use("BEN_SI")) THEN  
     1856          med_diag%BEN_SI%dgsave = .TRUE. 
     1857      ELSE  
     1858          med_diag%BEN_SI%dgsave = .FALSE. 
     1859      ENDIF 
     1860      IF  (iom_use("BEN_CA")) THEN  
     1861          med_diag%BEN_CA%dgsave = .TRUE. 
     1862      ELSE  
     1863          med_diag%BEN_CA%dgsave = .FALSE. 
     1864      ENDIF 
     1865      IF  (iom_use("RUNOFF")) THEN  
     1866          med_diag%RUNOFF%dgsave = .TRUE. 
     1867      ELSE  
     1868          med_diag%RUNOFF%dgsave = .FALSE. 
     1869      ENDIF 
     1870      IF  (iom_use("RIV_N")) THEN  
     1871          med_diag%RIV_N%dgsave = .TRUE. 
     1872      ELSE  
     1873          med_diag%RIV_N%dgsave = .FALSE. 
     1874      ENDIF 
     1875      IF  (iom_use("RIV_SI")) THEN  
     1876          med_diag%RIV_SI%dgsave = .TRUE. 
     1877      ELSE  
     1878          med_diag%RIV_SI%dgsave = .FALSE. 
     1879      ENDIF 
     1880      IF  (iom_use("RIV_C")) THEN  
     1881          med_diag%RIV_C%dgsave = .TRUE. 
     1882      ELSE  
     1883          med_diag%RIV_C%dgsave = .FALSE. 
     1884      ENDIF 
     1885      IF  (iom_use("RIV_ALK")) THEN  
     1886          med_diag%RIV_ALK%dgsave = .TRUE. 
     1887      ELSE  
     1888          med_diag%RIV_ALK%dgsave = .FALSE. 
     1889      ENDIF 
     1890      IF  (iom_use("DETC")) THEN  
     1891          med_diag%DETC%dgsave = .TRUE. 
     1892      ELSE  
     1893          med_diag%DETC%dgsave = .FALSE. 
     1894      ENDIF 
     1895      IF  (iom_use("SDC__100")) THEN  
     1896          med_diag%SDC__100%dgsave = .TRUE. 
     1897      ELSE  
     1898          med_diag%SDC__100%dgsave = .FALSE. 
     1899      ENDIF 
     1900      IF  (iom_use("SDC__200")) THEN  
     1901          med_diag%SDC__200%dgsave = .TRUE. 
     1902      ELSE  
     1903          med_diag%SDC__200%dgsave = .FALSE. 
     1904      ENDIF 
     1905      IF  (iom_use("SDC__500")) THEN  
     1906          med_diag%SDC__500%dgsave = .TRUE. 
     1907      ELSE  
     1908          med_diag%SDC__500%dgsave = .FALSE. 
     1909      ENDIF 
     1910      IF  (iom_use("SDC_1000")) THEN  
     1911          med_diag%SDC_1000%dgsave = .TRUE. 
     1912      ELSE  
     1913          med_diag%SDC_1000%dgsave = .FALSE. 
     1914      ENDIF 
     1915      IF  (iom_use("INVTC")) THEN  
     1916          med_diag%INVTC%dgsave = .TRUE. 
     1917      ELSE  
     1918          med_diag%INVTC%dgsave = .FALSE. 
     1919      ENDIF 
     1920      IF  (iom_use("INVTALK")) THEN  
     1921          med_diag%INVTALK%dgsave = .TRUE. 
     1922      ELSE  
     1923          med_diag%INVTALK%dgsave = .FALSE. 
     1924      ENDIF 
     1925      IF  (iom_use("INVTO2")) THEN  
     1926          med_diag%INVTO2%dgsave = .TRUE. 
     1927      ELSE  
     1928          med_diag%INVTO2%dgsave = .FALSE. 
     1929      ENDIF 
     1930      IF  (iom_use("LYSO_CA")) THEN  
     1931          med_diag%LYSO_CA%dgsave = .TRUE. 
     1932      ELSE  
     1933          med_diag%LYSO_CA%dgsave = .FALSE. 
     1934      ENDIF 
     1935      IF  (iom_use("COM_RESP")) THEN  
     1936          med_diag%COM_RESP%dgsave = .TRUE. 
     1937      ELSE  
     1938          med_diag%COM_RESP%dgsave = .FALSE. 
     1939      ENDIF 
     1940      IF  (iom_use("PN_LLOSS")) THEN  
     1941          med_diag%PN_LLOSS%dgsave = .TRUE. 
     1942      ELSE  
     1943          med_diag%PN_LLOSS%dgsave = .FALSE. 
     1944      ENDIF 
     1945      IF  (iom_use("PD_LLOSS")) THEN  
     1946          med_diag%PD_LLOSS%dgsave = .TRUE. 
     1947      ELSE  
     1948          med_diag%PD_LLOSS%dgsave = .FALSE. 
     1949      ENDIF 
     1950      IF  (iom_use("ZI_LLOSS")) THEN  
     1951          med_diag%ZI_LLOSS%dgsave = .TRUE. 
     1952      ELSE  
     1953          med_diag%ZI_LLOSS%dgsave = .FALSE. 
     1954      ENDIF 
     1955      IF  (iom_use("ZE_LLOSS")) THEN  
     1956          med_diag%ZE_LLOSS%dgsave = .TRUE. 
     1957      ELSE  
     1958          med_diag%ZE_LLOSS%dgsave = .FALSE. 
     1959      ENDIF 
     1960      IF  (iom_use("ZI_MES_N")) THEN  
     1961          med_diag%ZI_MES_N%dgsave = .TRUE. 
     1962      ELSE  
     1963          med_diag%ZI_MES_N%dgsave = .FALSE. 
     1964      ENDIF 
     1965      IF  (iom_use("ZI_MES_D")) THEN  
     1966          med_diag%ZI_MES_D%dgsave = .TRUE. 
     1967      ELSE  
     1968          med_diag%ZI_MES_D%dgsave = .FALSE. 
     1969      ENDIF 
     1970      IF  (iom_use("ZI_MES_C")) THEN  
     1971          med_diag%ZI_MES_C%dgsave = .TRUE. 
     1972      ELSE  
     1973          med_diag%ZI_MES_C%dgsave = .FALSE. 
     1974      ENDIF 
     1975      IF  (iom_use("ZI_MESDC")) THEN  
     1976          med_diag%ZI_MESDC%dgsave = .TRUE. 
     1977      ELSE  
     1978          med_diag%ZI_MESDC%dgsave = .FALSE. 
     1979      ENDIF 
     1980      IF  (iom_use("ZI_EXCR")) THEN  
     1981          med_diag%ZI_EXCR%dgsave = .TRUE. 
     1982      ELSE  
     1983          med_diag%ZI_EXCR%dgsave = .FALSE. 
     1984      ENDIF 
     1985      IF  (iom_use("ZI_RESP")) THEN  
     1986          med_diag%ZI_RESP%dgsave = .TRUE. 
     1987      ELSE  
     1988          med_diag%ZI_RESP%dgsave = .FALSE. 
     1989      ENDIF 
     1990      IF  (iom_use("ZI_GROW")) THEN  
     1991          med_diag%ZI_GROW%dgsave = .TRUE. 
     1992      ELSE  
     1993          med_diag%ZI_GROW%dgsave = .FALSE. 
     1994      ENDIF 
     1995      IF  (iom_use("ZE_MES_N")) THEN  
     1996          med_diag%ZE_MES_N%dgsave = .TRUE. 
     1997      ELSE  
     1998          med_diag%ZE_MES_N%dgsave = .FALSE. 
     1999      ENDIF 
     2000      IF  (iom_use("ZE_MES_D")) THEN  
     2001          med_diag%ZE_MES_D%dgsave = .TRUE. 
     2002      ELSE  
     2003          med_diag%ZE_MES_D%dgsave = .FALSE. 
     2004      ENDIF 
     2005      IF  (iom_use("ZE_MES_C")) THEN  
     2006          med_diag%ZE_MES_C%dgsave = .TRUE. 
     2007      ELSE  
     2008          med_diag%ZE_MES_C%dgsave = .FALSE. 
     2009      ENDIF 
     2010      IF  (iom_use("ZE_MESDC")) THEN  
     2011          med_diag%ZE_MESDC%dgsave = .TRUE. 
     2012      ELSE  
     2013          med_diag%ZE_MESDC%dgsave = .FALSE. 
     2014      ENDIF 
     2015      IF  (iom_use("ZE_EXCR")) THEN  
     2016          med_diag%ZE_EXCR%dgsave = .TRUE. 
     2017      ELSE  
     2018          med_diag%ZE_EXCR%dgsave = .FALSE. 
     2019      ENDIF 
     2020      IF  (iom_use("ZE_RESP")) THEN  
     2021          med_diag%ZE_RESP%dgsave = .TRUE. 
     2022      ELSE  
     2023          med_diag%ZE_RESP%dgsave = .FALSE. 
     2024      ENDIF 
     2025      IF  (iom_use("ZE_GROW")) THEN  
     2026          med_diag%ZE_GROW%dgsave = .TRUE. 
     2027      ELSE  
     2028          med_diag%ZE_GROW%dgsave = .FALSE. 
     2029      ENDIF 
     2030      IF  (iom_use("MDETC")) THEN  
     2031          med_diag%MDETC%dgsave = .TRUE. 
     2032      ELSE  
     2033          med_diag%MDETC%dgsave = .FALSE. 
     2034      ENDIF 
     2035      IF  (iom_use("GMIDC")) THEN  
     2036          med_diag%GMIDC%dgsave = .TRUE. 
     2037      ELSE  
     2038          med_diag%GMIDC%dgsave = .FALSE. 
     2039      ENDIF 
     2040      IF  (iom_use("GMEDC")) THEN  
     2041          med_diag%GMEDC%dgsave = .TRUE. 
     2042      ELSE  
     2043          med_diag%GMEDC%dgsave = .FALSE. 
     2044      ENDIF 
     2045      IF  (iom_use("BASIN_01")) THEN  
     2046          med_diag%BASIN_01%dgsave = .TRUE. 
     2047      ELSE  
     2048          med_diag%BASIN_01%dgsave = .FALSE. 
     2049      ENDIF 
     2050      IF  (iom_use("BASIN_02")) THEN  
     2051          med_diag%BASIN_02%dgsave = .TRUE. 
     2052      ELSE  
     2053          med_diag%BASIN_02%dgsave = .FALSE. 
     2054      ENDIF 
     2055      IF  (iom_use("BASIN_03")) THEN  
     2056          med_diag%BASIN_03%dgsave = .TRUE. 
     2057      ELSE  
     2058          med_diag%BASIN_03%dgsave = .FALSE. 
     2059      ENDIF 
     2060      IF  (iom_use("BASIN_04")) THEN  
     2061          med_diag%BASIN_04%dgsave = .TRUE. 
     2062      ELSE  
     2063          med_diag%BASIN_04%dgsave = .FALSE. 
     2064      ENDIF 
     2065      IF  (iom_use("BASIN_05")) THEN  
     2066          med_diag%BASIN_05%dgsave = .TRUE. 
     2067      ELSE  
     2068          med_diag%BASIN_05%dgsave = .FALSE. 
     2069      ENDIF 
     2070      IF  (iom_use("BASIN_06")) THEN  
     2071          med_diag%BASIN_06%dgsave = .TRUE. 
     2072      ELSE  
     2073          med_diag%BASIN_06%dgsave = .FALSE. 
     2074      ENDIF 
     2075      IF  (iom_use("BASIN_07")) THEN  
     2076          med_diag%BASIN_07%dgsave = .TRUE. 
     2077      ELSE  
     2078          med_diag%BASIN_07%dgsave = .FALSE. 
     2079      ENDIF 
     2080      IF  (iom_use("BASIN_08")) THEN  
     2081          med_diag%BASIN_08%dgsave = .TRUE. 
     2082      ELSE  
     2083          med_diag%BASIN_08%dgsave = .FALSE. 
     2084      ENDIF 
     2085      IF  (iom_use("BASIN_09")) THEN  
     2086          med_diag%BASIN_09%dgsave = .TRUE. 
     2087      ELSE  
     2088          med_diag%BASIN_09%dgsave = .FALSE. 
     2089      ENDIF 
     2090      IF  (iom_use("BASIN_10")) THEN  
     2091          med_diag%BASIN_10%dgsave = .TRUE. 
     2092      ELSE  
     2093          med_diag%BASIN_10%dgsave = .FALSE. 
     2094      ENDIF 
     2095      IF  (iom_use("BASIN_11")) THEN  
     2096          med_diag%BASIN_11%dgsave = .TRUE. 
     2097      ELSE  
     2098          med_diag%BASIN_11%dgsave = .FALSE. 
     2099      ENDIF 
     2100      IF  (iom_use("BASIN_12")) THEN  
     2101          med_diag%BASIN_12%dgsave = .TRUE. 
     2102      ELSE  
     2103          med_diag%BASIN_12%dgsave = .FALSE. 
     2104      ENDIF 
     2105      IF  (iom_use("BASIN_13")) THEN  
     2106          med_diag%BASIN_13%dgsave = .TRUE. 
     2107      ELSE  
     2108          med_diag%BASIN_13%dgsave = .FALSE. 
     2109      ENDIF 
     2110      IF  (iom_use("BASIN_14")) THEN  
     2111          med_diag%BASIN_14%dgsave = .TRUE. 
     2112      ELSE  
     2113          med_diag%BASIN_14%dgsave = .FALSE. 
     2114      ENDIF 
     2115      IF  (iom_use("BASIN_15")) THEN  
     2116          med_diag%BASIN_15%dgsave = .TRUE. 
     2117      ELSE  
     2118          med_diag%BASIN_15%dgsave = .FALSE. 
     2119      ENDIF 
     2120      IF  (iom_use("BASIN_16")) THEN  
     2121          med_diag%BASIN_16%dgsave = .TRUE. 
     2122      ELSE  
     2123          med_diag%BASIN_16%dgsave = .FALSE. 
     2124      ENDIF 
     2125      IF  (iom_use("BASIN_17")) THEN  
     2126          med_diag%BASIN_17%dgsave = .TRUE. 
     2127      ELSE  
     2128          med_diag%BASIN_17%dgsave = .FALSE. 
     2129      ENDIF 
     2130      IF  (iom_use("BASIN_18")) THEN  
     2131          med_diag%BASIN_18%dgsave = .TRUE. 
     2132      ELSE  
     2133          med_diag%BASIN_18%dgsave = .FALSE. 
     2134      ENDIF 
     2135      IF  (iom_use("BASIN_19")) THEN  
     2136          med_diag%BASIN_19%dgsave = .TRUE. 
     2137      ELSE  
     2138          med_diag%BASIN_19%dgsave = .FALSE. 
     2139      ENDIF 
     2140      IF  (iom_use("BASIN_20")) THEN  
     2141          med_diag%BASIN_20%dgsave = .TRUE. 
     2142      ELSE  
     2143          med_diag%BASIN_20%dgsave = .FALSE. 
     2144      ENDIF 
     2145      IF  (iom_use("BASIN_21")) THEN  
     2146          med_diag%BASIN_21%dgsave = .TRUE. 
     2147      ELSE  
     2148          med_diag%BASIN_21%dgsave = .FALSE. 
     2149      ENDIF 
     2150      IF  (iom_use("BASIN_22")) THEN  
     2151          med_diag%BASIN_22%dgsave = .TRUE. 
     2152      ELSE  
     2153          med_diag%BASIN_22%dgsave = .FALSE. 
     2154      ENDIF 
     2155      IF  (iom_use("BASIN_23")) THEN  
     2156          med_diag%BASIN_23%dgsave = .TRUE. 
     2157      ELSE  
     2158          med_diag%BASIN_23%dgsave = .FALSE. 
     2159      ENDIF 
     2160      IF  (iom_use("BASIN_24")) THEN  
     2161          med_diag%BASIN_24%dgsave = .TRUE. 
     2162      ELSE  
     2163          med_diag%BASIN_24%dgsave = .FALSE. 
     2164      ENDIF 
     2165      IF  (iom_use("BASIN_25")) THEN  
     2166          med_diag%BASIN_25%dgsave = .TRUE. 
     2167      ELSE  
     2168          med_diag%BASIN_25%dgsave = .FALSE. 
     2169      ENDIF 
     2170      IF  (iom_use("BASIN_26")) THEN  
     2171          med_diag%BASIN_26%dgsave = .TRUE. 
     2172      ELSE  
     2173          med_diag%BASIN_26%dgsave = .FALSE. 
     2174      ENDIF 
     2175      IF  (iom_use("BASIN_27")) THEN  
     2176          med_diag%BASIN_27%dgsave = .TRUE. 
     2177      ELSE  
     2178          med_diag%BASIN_27%dgsave = .FALSE. 
     2179      ENDIF 
     2180      IF  (iom_use("BASIN_28")) THEN  
     2181          med_diag%BASIN_28%dgsave = .TRUE. 
     2182      ELSE  
     2183          med_diag%BASIN_28%dgsave = .FALSE. 
     2184      ENDIF 
     2185      IF  (iom_use("BASIN_29")) THEN  
     2186          med_diag%BASIN_29%dgsave = .TRUE. 
     2187      ELSE  
     2188          med_diag%BASIN_29%dgsave = .FALSE. 
     2189      ENDIF 
     2190      IF  (iom_use("BASIN_30")) THEN  
     2191          med_diag%BASIN_30%dgsave = .TRUE. 
     2192      ELSE  
     2193          med_diag%BASIN_30%dgsave = .FALSE. 
     2194      ENDIF 
     2195      IF  (iom_use("BASIN_31")) THEN  
     2196          med_diag%BASIN_31%dgsave = .TRUE. 
     2197      ELSE  
     2198          med_diag%BASIN_31%dgsave = .FALSE. 
     2199      ENDIF 
     2200      IF  (iom_use("BASIN_32")) THEN  
     2201          med_diag%BASIN_32%dgsave = .TRUE. 
     2202      ELSE  
     2203          med_diag%BASIN_32%dgsave = .FALSE. 
     2204      ENDIF 
     2205      IF  (iom_use("BASIN_33")) THEN  
     2206          med_diag%BASIN_33%dgsave = .TRUE. 
     2207      ELSE  
     2208          med_diag%BASIN_33%dgsave = .FALSE. 
     2209      ENDIF 
     2210      IF  (iom_use("BASIN_34")) THEN  
     2211          med_diag%BASIN_34%dgsave = .TRUE. 
     2212      ELSE  
     2213          med_diag%BASIN_34%dgsave = .FALSE. 
     2214      ENDIF 
     2215      IF  (iom_use("BASIN_35")) THEN  
     2216          med_diag%BASIN_35%dgsave = .TRUE. 
     2217      ELSE  
     2218          med_diag%BASIN_35%dgsave = .FALSE. 
     2219      ENDIF 
     2220      IF  (iom_use("BASIN_36")) THEN  
     2221          med_diag%BASIN_36%dgsave = .TRUE. 
     2222      ELSE  
     2223          med_diag%BASIN_36%dgsave = .FALSE. 
     2224      ENDIF 
     2225      IF  (iom_use("BASIN_37")) THEN  
     2226          med_diag%BASIN_37%dgsave = .TRUE. 
     2227      ELSE  
     2228          med_diag%BASIN_37%dgsave = .FALSE. 
     2229      ENDIF 
     2230      IF  (iom_use("BASIN_38")) THEN  
     2231          med_diag%BASIN_38%dgsave = .TRUE. 
     2232      ELSE  
     2233          med_diag%BASIN_38%dgsave = .FALSE. 
     2234      ENDIF 
     2235      IF  (iom_use("BASIN_39")) THEN  
     2236          med_diag%BASIN_39%dgsave = .TRUE. 
     2237      ELSE  
     2238          med_diag%BASIN_39%dgsave = .FALSE. 
     2239      ENDIF 
     2240      IF  (iom_use("BASIN_40")) THEN  
     2241          med_diag%BASIN_40%dgsave = .TRUE. 
     2242      ELSE  
     2243          med_diag%BASIN_40%dgsave = .FALSE. 
     2244      ENDIF 
     2245      IF  (iom_use("BASIN_41")) THEN  
     2246          med_diag%BASIN_41%dgsave = .TRUE. 
     2247      ELSE  
     2248          med_diag%BASIN_41%dgsave = .FALSE. 
     2249      ENDIF 
     2250      IF  (iom_use("BASIN_42")) THEN  
     2251          med_diag%BASIN_42%dgsave = .TRUE. 
     2252      ELSE  
     2253          med_diag%BASIN_42%dgsave = .FALSE. 
     2254      ENDIF 
     2255      IF  (iom_use("BASIN_43")) THEN  
     2256          med_diag%BASIN_43%dgsave = .TRUE. 
     2257      ELSE  
     2258          med_diag%BASIN_43%dgsave = .FALSE. 
     2259      ENDIF 
     2260      IF  (iom_use("BASIN_44")) THEN  
     2261          med_diag%BASIN_44%dgsave = .TRUE. 
     2262      ELSE  
     2263          med_diag%BASIN_44%dgsave = .FALSE. 
     2264      ENDIF 
     2265      IF  (iom_use("BASIN_45")) THEN  
     2266          med_diag%BASIN_45%dgsave = .TRUE. 
     2267      ELSE  
     2268          med_diag%BASIN_45%dgsave = .FALSE. 
     2269      ENDIF 
     2270      IF  (iom_use("INT_ZMI")) THEN  
     2271          med_diag%INT_ZMI%dgsave = .TRUE. 
     2272      ELSE  
     2273          med_diag%INT_ZMI%dgsave = .FALSE. 
     2274      ENDIF 
     2275      IF  (iom_use("INT_ZME")) THEN  
     2276          med_diag%INT_ZME%dgsave = .TRUE. 
     2277      ELSE  
     2278          med_diag%INT_ZME%dgsave = .FALSE. 
     2279      ENDIF 
     2280      IF  (iom_use("INT_DET")) THEN  
     2281          med_diag%INT_DET%dgsave = .TRUE. 
     2282      ELSE  
     2283          med_diag%INT_DET%dgsave = .FALSE. 
     2284      ENDIF 
     2285      IF  (iom_use("INT_DTC")) THEN  
     2286          med_diag%INT_DTC%dgsave = .TRUE. 
     2287      ELSE  
     2288          med_diag%INT_DTC%dgsave = .FALSE. 
     2289      ENDIF 
     2290      IF  (iom_use("DMS_SURF")) THEN  
     2291          med_diag%DMS_SURF%dgsave = .TRUE. 
     2292      ELSE  
     2293          med_diag%DMS_SURF%dgsave = .FALSE. 
     2294      ENDIF 
     2295      IF  (iom_use("DMS_ANDR")) THEN  
     2296          med_diag%DMS_ANDR%dgsave = .TRUE. 
     2297      ELSE  
     2298          med_diag%DMS_ANDR%dgsave = .FALSE. 
     2299      ENDIF 
     2300      IF  (iom_use("DMS_SIMO")) THEN  
     2301          med_diag%DMS_SIMO%dgsave = .TRUE. 
     2302      ELSE  
     2303          med_diag%DMS_SIMO%dgsave = .FALSE. 
     2304      ENDIF 
     2305      IF  (iom_use("DMS_ARAN")) THEN  
     2306          med_diag%DMS_ARAN%dgsave = .TRUE. 
     2307      ELSE  
     2308          med_diag%DMS_ARAN%dgsave = .FALSE. 
     2309      ENDIF 
     2310      IF  (iom_use("DMS_HALL")) THEN  
     2311          med_diag%DMS_HALL%dgsave = .TRUE. 
     2312      ELSE  
     2313          med_diag%DMS_HALL%dgsave = .FALSE. 
     2314      ENDIF 
     2315      IF  (iom_use("TPP3")) THEN  
     2316          med_diag%TPP3%dgsave = .TRUE. 
     2317      ELSE  
     2318          med_diag%TPP3%dgsave = .FALSE. 
     2319      ENDIF 
     2320      IF  (iom_use("DETFLUX3")) THEN  
     2321          med_diag%DETFLUX3%dgsave = .TRUE. 
     2322      ELSE  
     2323          med_diag%DETFLUX3%dgsave = .FALSE. 
     2324      ENDIF 
     2325      IF  (iom_use("REMIN3N")) THEN  
     2326          med_diag%REMIN3N%dgsave = .TRUE. 
     2327      ELSE  
     2328          med_diag%REMIN3N%dgsave = .FALSE. 
     2329      ENDIF 
     2330      IF  (iom_use("PH3")) THEN  
     2331          med_diag%PH3%dgsave = .TRUE. 
     2332      ELSE  
     2333          med_diag%PH3%dgsave = .FALSE. 
     2334      ENDIF 
     2335      IF  (iom_use("OM_CAL3")) THEN  
     2336          med_diag%OM_CAL3%dgsave = .TRUE. 
     2337      ELSE  
     2338          med_diag%OM_CAL3%dgsave = .FALSE. 
     2339      ENDIF 
     2340      !! 
     2341      !! 
     2342   END SUBROUTINE   trc_nam_iom_medusa 
     2343    
    11282344#else 
    11292345   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcopt_medusa.F90

    r5726 r6639  
    7373      ! determination of surface irradiance 
    7474      ! ----------------------------------- 
    75       zpar0m (:,:)   = qsr   (:,:) * 0.43 
     75      ! AXY (23/07/15): the inclusion of empirical DMS calculations requires 
     76      !                 daily averages of a series of properties that are 
     77      !                 used as inputs; these include surface irradiance;  
     78      !                 here, this is taken advantage of to allow MEDUSA to 
     79      !                 base its submarine light field on daily average 
     80      !                 rather than "instantaneous" irradiance; largely 
     81      !                 because MEDUSA was originally formulated to work 
     82      !                 with diel average irradiance rather than a diel 
     83      !                 cycle; using key_avgqsr_medusa activates this 
     84      !                 functionality, while its absence gives default 
     85      !                 MEDUSA (which is whatever is supplied by NEMO) 
     86# if defined key_avgqsr_medusa 
     87      ! surface irradiance input is rolling average irradiance 
     88      zpar0m (:,:)   = zn_dms_qsr(:,:) * 0.43 
     89# else       
     90      ! surface irradiance input is   instantaneous irradiance 
     91      zpar0m (:,:)   =        qsr(:,:) * 0.43 
     92# endif 
    7693      ! AXY (22/08/14): when zpar0m = 0, zpar100 is also zero and calculating  
    7794      !                 euphotic depth is not possible (cf. the Arctic Octopus);  
    … …  
    92109      zparr  (:,:,1) = 0.5 * zpar0m(:,:) 
    93110      zparg  (:,:,1) = 0.5 * zpar0m(:,:) 
    94  
    95111 
    96112      ! determination of xpar 
    … …  
    146162      ENDDO  
    147163 
    148  
    149164      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    150165         WRITE(charout, FMT="('opt')") 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcoxy_medusa.F90

    r5726 r6639  
    3434! The following is a map of the subroutines contained within this module 
    3535! - trc_oxy_medusa 
    36 !      - CALLS gas_transfer 
    3736!      - CALLS oxy_schmidt 
    3837!      - CALLS oxy_sato 
    … …  
    4241!======================================================================= 
    4342! 
    44    SUBROUTINE trc_oxy_medusa( pt, ps, uwind, vwind, pp0, o2, dz, &  !! inputs 
    45       kw660, o2flux, o2sat )                                        !! outputs 
     43   SUBROUTINE trc_oxy_medusa( pt, ps, kw660, pp0, o2, &  !! inputs 
     44      kwo2, o2flux, o2sat )                               !! outputs 
    4645!       
    4746!======================================================================= 
    … …  
    5756      !! number of oxygen) and oxy_sato.f (calculates oxygen saturation  
    5857      !! concentration at 1 atm). 
     58      !! 
     59      !! AXY (23/06/15): revised to allow common gas transfer velocity 
     60      !!                 to be used for CO2 and O2; outputs of this 
     61      !!                 routine amended to mmol/m3 from mol/m3 
    5962      !!  
    6063      !! Function inputs are (in order) :  
    6164      !!     pt      temperature                     (degrees C) 
    6265      !!     ps      salinity                        (PSU) 
    63       !!     uwind   u-wind velocity                 (m/s) 
    64       !!     vwind   v-wind velocity                 (m/s) 
     66      !!     kw660   gas transfer velocity           (m/s) 
    6567      !!     pp0     surface pressure                (divided by 1 atm) 
    66       !!     o2      surface O2 concentration        (mol/m3) 
    67       !!     dz      surface layer thickness         (m) 
    68       !! (*) kw660   gas transfer velocity           (m/s) 
    69       !! (*) o2flux  exchange rate of oxygen         (mol/m3/s) 
    70       !! (+) o2sat   oxygen saturation concentration (mol/m3) 
     68      !!     o2      surface O2 concentration        (mmol/m3) 
     69      !! (+) kwo2    gas transfer velocity for O2    (m/s) 
     70      !! (*) o2flux  exchange rate of oxygen         (mmol/m2/s) 
     71      !! (+) o2sat   oxygen saturation concentration (mmol/m3) 
    7172      !!  
    7273      !! Where (*) is the function output (note its units).   
    … …  
    7879      REAL(wp), INTENT( in )    :: pt 
    7980      REAL(wp), INTENT( in )    :: ps 
    80       REAL(wp), INTENT( in )    :: uwind 
    81       REAL(wp), INTENT( in )    :: vwind 
     81      REAL(wp), INTENT( in )    :: kw660 
    8282      REAL(wp), INTENT( in )    :: pp0 
    8383      REAL(wp), INTENT( in )    :: o2 
    84       REAL(wp), INTENT( in )    :: dz 
    85       REAL(wp), INTENT( inout ) :: kw660, o2flux, o2sat 
    86 ! 
    87       REAL(wp) :: scl_wind, kwo2, o2schmidt, o2sato 
    88 ! 
    89 ! Calculate gas transfer 
    90 !  
    91       call gas_transfer(uwind, vwind, scl_wind, kw660) 
     84      REAL(wp), INTENT( out )   :: kwo2, o2flux, o2sat 
     85! 
     86      REAL(wp) :: o2schmidt, o2sato, mol_o2 
     87! 
     88! Oxygen to mol / m3 
     89! 
     90      mol_o2 = o2 / 1000. 
    9291! 
    9392! Calculate oxygen Schmidt number 
    … …  
    106105! Calculate time rate of change of O2 due to gas exchange (mol/m3/s) 
    107106! 
    108       o2flux = kwo2 * (o2sat - o2) / dz 
     107      o2flux = kwo2 * (o2sat - mol_o2) 
     108! 
     109! Oxygen flux and saturation to mmol / m3 
     110! 
     111      o2sat  =  o2sat * 1000. 
     112      o2flux = o2flux * 1000. 
    109113! 
    110114      END SUBROUTINE trc_oxy_medusa 
    … …  
    130134      !! are taken from Keeling et al. (1998, GBC, 12, 141-163). 
    131135      !!  
     136      !! AXY (23/06/2015) 
     137      !! UPDATED: revised formulation from Wanninkhof (2014) for 
     138      !! consistency with MOCSY 
     139      !! 
     140      !! Winninkhof, R. (2014). Relationship between wind speed and gas 
     141      !! exchange over the ocean revisited. LIMNOLOGY AND OCEANOGRAPHY-METHODS 
     142      !! 12, 351-362, doi:10.4319/lom.2014.12.351 
     143      !! 
    132144      !! Function inputs are (in order) :  
    133145      !!     t           temperature (degrees C) 
    … …  
    141153! 
    142154      REAL(wp) :: pt, o2_schmidt 
    143       REAL(wp) :: a0, a1, a2, a3 
    144 ! 
    145       data a0 /    1638.0 / 
    146       data a1 /    -81.83 / 
    147       data a2 /     1.483 / 
    148       data a3 / -0.008004 / 
    149 ! 
    150       o2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*a3)) 
     155      REAL(wp) :: a0, a1, a2, a3, a4 
     156! 
     157! AXY (23/06/15): OCMIP-2 coefficients 
     158!     data a0 /    1638.0 / 
     159!     data a1 /    -81.83 / 
     160!     data a2 /     1.483 / 
     161!     data a3 / -0.008004 / 
     162! 
     163! AXY (23/06/15): Wanninkhof (2014) coefficients 
     164      data a0 /     1920.4 / 
     165      data a1 /     -135.6 / 
     166      data a2 /     5.2121 / 
     167      data a3 /   -0.10939 / 
     168      data a4 / 0.00093777 / 
     169! 
     170!     o2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*a3)) 
     171      o2_schmidt = a0 + pt*(a1 + pt*(a2 + pt*(a3 + pt*a4))) 
    151172! 
    152173      END SUBROUTINE oxy_schmidt 
    … …  
    231252!======================================================================= 
    232253 
    233 !======================================================================= 
    234 ! 
    235    SUBROUTINE gas_transfer( uwind, vwind, &  !! input  
    236       scl_wind, k )                          !! output 
    237 !       
    238 !======================================================================= 
    239       !! 
    240       !! Title  : Calculates gas transfer velocity 
    241       !! Author : Andrew Yool 
    242       !! Date   : 15/10/04 (revised 04/08/2011) 
    243       !!  
    244       !! This subroutine uses near-surface wind speed to calculate gas 
    245       !! transfer velocity for use in CO2 and O2 exchange calculations. 
    246       !!  
    247       !! Note that the parameterisation of Wanninkhof quoted here is a 
    248       !! truncation of the original equation.  It excludes a chemical 
    249       !! enhancement function (based on temperature), although such 
    250       !! temperature dependence is reported negligible by Etcheto & 
    251       !! Merlivat (1988). 
    252       !!  
    253       !! Note also that in calculating scalar wind, the variance of the 
    254       !! wind over the period of a timestep is ignored.  Some authors, 
    255       !! for instance OCMIP-2, favour including some reference to the 
    256       !! variability of wind.  However, their wind fields are averaged 
    257       !! over relatively long time periods, and so this issue may be 
    258       !! safely (!) ignored here. 
    259       !!  
    260       !! Subroutine inputs are (in order) : 
    261       !!     uwind     wind u velocity at 10 m (m/s) 
    262       !!     vwind     wind v velocity at 10 m (m/s) 
    263       !! (+) scl_wind  scalar wind velocity at 10 m (m/s) 
    264       !! (*) k         gas transfer velocity (m/s) 
    265       !! Where (*) is the function output and (+) is a diagnostic output. 
    266       !! 
    267 !======================================================================= 
    268  
    269       implicit none 
    270 ! 
    271 ! Input variables 
    272       REAL(wp) :: uwind, vwind 
    273 ! 
    274 ! Output variables 
    275       REAL(wp) :: scl_wind, k, tmp_k 
    276 ! 
    277 ! Choice of parameterisation 
    278       INTEGER  :: eqn 
    279 ! 
    280 ! Coefficients for various parameterisations 
    281       REAL(wp), DIMENSION(6) :: a 
    282       REAL(wp), DIMENSION(6) :: b 
    283 ! 
    284 ! Values of coefficients 
    285       data a(1) / 0.166 /  ! Liss & Merlivat (1986)    [approximated] 
    286       data a(2) / 0.3   /  ! Wanninkhof (1992)         [sans enhancement] 
    287       data a(3) / 0.23  /  ! Nightingale et al. (2000) [good] 
    288       data a(4) / 0.23  /  ! Nightingale et al. (2000) [better] 
    289       data a(5) / 0.222 /  ! Nightingale et al. (2000) [best] 
    290       data a(6) / 0.337 /  ! OCMIP-2                   [sans variability] 
    291 ! 
    292       data b(1) / 0.133 / 
    293       data b(2) / 0.0   / 
    294       data b(3) / 0.0   / 
    295       data b(4) / 0.1   / 
    296       data b(5) / 0.333 / 
    297       data b(6) / 0.0   / 
    298 ! 
    299 ! Which parameterisation is to be used? 
    300       eqn = 2 
    301 ! 
    302 ! Calculate scalar wind (m/s) 
    303       scl_wind = (uwind**2 + vwind**2)**0.5 
    304 ! 
    305 ! Calculate gas transfer velocity (cm/h) 
    306       tmp_k = (a(eqn) * scl_wind**2) + (b(eqn) * scl_wind) 
    307 ! 
    308 ! Convert tmp_k from cm/h to m/s 
    309       k = tmp_k / (100. * 3600.) 
    310 ! 
    311       END SUBROUTINE gas_transfer 
    312  
    313 !======================================================================= 
    314 !======================================================================= 
    315 !======================================================================= 
    316  
    317254#else 
    318255   !!====================================================================== 
    … …  
    322259CONTAINS 
    323260 
    324    SUBROUTINE trc_oxy_medusa( pt, ps, uwind, vwind, pp0, o2, dz, &  !! inputs 
    325       kw660, o2flux, o2sat )                                        !! outputs 
     261   SUBROUTINE trc_oxy_medusa( pt, ps, kw660, pp0, o2, &  !! inputs 
     262      o2flux, o2sat )                                     !! outputs 
    326263      USE par_kind 
    327264 
    328265      REAL(wp), INTENT( in )    :: pt 
    329266      REAL(wp), INTENT( in )    :: ps 
     267      REAL(wp), INTENT( in )    :: kw660 
    330268      REAL(wp), INTENT( in )    :: pp0 
    331269      REAL(wp), INTENT( in )    :: o2 
    332       REAL(wp), INTENT( in )    :: dz 
    333       REAL(wp), INTENT( inout ) :: kw660, o2flux, o2sat 
     270      REAL(wp), INTENT( inout ) :: o2flux, o2sat 
    334271 
    335272      WRITE(*,*) 'trc_oxy_medusa: You should not have seen this print! error?', kt 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90

    r5726 r6639  
    2323   !! AXY (10/02/09) 
    2424   USE iom 
    25  
     25   !! USE trc_nam_dia         ! JPALM 13-11-2015 -- if iom_use for diag 
     26   !! USE trc_nam_iom_medusa  ! JPALM 13-11-2015 -- if iom_use for diag 
     27   USE fldread         !  time interpolation 
    2628   USE lbclnk 
    2729   USE prtctl_trc      ! Print control for debbuging 
    … …  
    3941 
    4042   !! AXY (10/02/09) 
    41    LOGICAL, PUBLIC ::                  & 
    42       bdustfer = .TRUE. 
     43   LOGICAL, PUBLIC  ::   bdustfer  !: boolean for dust input from the atmosphere 
    4344   REAL(wp), PUBLIC ::                 & 
    4445      sedfeinput = 1.e-9_wp  ,         & 
    4546      dustsolub  = 0.014_wp 
     47 
     48   INTEGER , PARAMETER :: nbtimes = 365  !: maximum number of times record in a file 
     49   INTEGER  :: ntimes_dust               ! number of time steps in a file 
     50 
    4651   INTEGER ::                          & 
    4752      numdust,                         & 
    4853      nflx1,  nflx2,                   & 
    4954      nflx11, nflx12 
     55    
     56   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust 
     57 
     58    
    5059   !!* Substitution 
    5160#  include "domzgr_substitute.h90" 
    … …  
    9099 
    91100      CHARACTER (len=25) :: charout 
     101       
     102      !! JPALM - 26-11-2015 -add iom_use for diagnostic 
     103       REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
    92104      !!--------------------------------------------------------------------- 
    93  
     105      !! 
     106      IF( lk_iomput) THEN   
     107           IF( med_diag%DSED%dgsave ) THEN 
     108               CALL wrk_alloc( jpi, jpj,      zw2d ) 
     109                zw2d(:,:)      = 0.0      !! 
     110           ENDIF 
     111      ENDIF 
     112       
    94113      !! AXY (10/02/09) 
    95114      jnt = 1 
    … …  
    120139 
    121140      !! AXY (10/02/09) 
    122       IF( (jnt == 1) .and. (bdustfer) )  CALL trc_sed_medusa_sbc( kt ) 
     141      !!IF( (jnt == 1) .and. (bdustfer) )  CALL trc_sed_medusa_sbc( kt ) 
     142      !! JPALM -- 31-03-2016 -- rewrite trc_sed_medusa_sbc. 
     143      !! IF (kt == nittrc000 ) CALL trc_sed_medusa_sbc  
     144      IF( bdustfer ) THEN 
     145         IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_dust > 1 ) ) THEN 
     146            CALL fld_read( kt, 1, sf_dust ) 
     147            dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     148         ENDIF 
     149      ELSE 
     150         dust(:,:) = 0.0 
     151      ENDIF 
     152      !! 
     153            
    123154      !! 
    124155      zirondep(:,:,:) = 0.e0     !! Initialisation of deposition variables 
    … …  
    165196               trbio(ji,jj,jk,8) = ztra 
    166197# endif 
    167                IF( ln_diatrc ) & 
    168                   &  trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 
     198               IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 
     199                     IF( med_diag%DSED%dgsave ) THEN 
     200                         zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400 
     201                      ENDIF    
     202               ELSE IF( ln_diatrc )  THEN 
     203                    trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400 
     204               ENDIF     
     205                 
    169206            END DO 
    170207         END DO 
    … …  
    175212# endif 
    176213      IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d 
    177 # if defined key_iomput 
    178       CALL iom_put( "DSED",trc2d(:,:,8) ) 
    179 # endif 
    180  
     214      !! 
     215      IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 
     216           IF( med_diag%DSED%dgsave ) THEN 
     217                CALL iom_put( "DSED"  ,  zw2d) 
     218                CALL wrk_dealloc( jpi, jpj,    zw2d  ) 
     219            ENDIF 
     220      ELSE IF (lk_iomput .AND. ln_diatrc)  THEN     
     221          CALL iom_put( "DSED",trc2d(:,:,8) ) 
     222      ENDIF 
     223      !! 
    181224# if defined key_roam 
    182225 
    … …  
    238281 
    239282   !! AXY (10/02/09) 
     283   !! JPALM -- 31-03-2016 -- Completely change trc_sed_medusa_sbc. 
     284   !!                     -- We now need to read dust file through a namelist. 
     285   !!                     To be able to use time varying dust depositions from 
     286   !!                     -- copy and adapt the PISCES p4z_sbc_ini subroutine 
     287   !!                     -- Only use the dust related part.       
    240288   SUBROUTINE trc_sed_medusa_sbc(kt) 
    241289 
    … …  
    243291      !!                  ***  ROUTINE trc_sed_medusa_sbc  *** 
    244292      !! 
    245       !! ** Purpose :   Read and interpolate the external sources of  
    246       !!                nutrients 
    247       !! 
    248       !! ** Method  :   Read the files and interpolate the appropriate variables 
    249       !! 
    250       !! ** input   :   external netcdf files 
     293      !! ** Purpose :   Read and dust namelist and files. 
     294      !!                The interpolation is done in trc_sed through  
     295      !!                "CALL fld_read( kt, 1, sf_dust )" 
     296      !! 
     297      !! ** Method  :   Read the sbc namelist, and the adapted dust file, if required 
     298      !!                called at the first timestep (nittrc000) 
     299      !! 
     300      !! ** input   :   -- namelist sbc ref and cfg 
     301      !!                -- external netcdf files 
    251302      !! 
    252303      !!---------------------------------------------------------------------- 
    253304      !! * arguments 
    254305      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    255  
    256       !! * Local declarations 
    257       INTEGER ::   & 
    258          imois, imois2,       &  ! temporary integers 
    259          i15  , iman             !    "          " 
    260       REAL(wp) ::   & 
    261          zxy                     !    "         " 
     306      INTEGER  :: ji, jj, jk, jm, ifpr 
     307      INTEGER  :: ii0, ii1, ij0, ij1 
     308      INTEGER  :: numdust 
     309      INTEGER  :: ierr  
     310      INTEGER  :: ios                 ! Local integer output status for namelist read 
     311      INTEGER  :: isrow             ! index for ORCA1 starting row 
     312      REAL(wp) :: ztimes_dust 
     313      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records 
     314      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust 
     315      ! 
     316      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
     317      TYPE(FLD_N) ::   sn_dust               ! informations about the fields to be read 
     318      ! 
     319      NAMELIST/nammedsbc/cn_dir, sn_dust, bdustfer  
    262320 
    263321      !!--------------------------------------------------------------------- 
    264  
    265       !! Initialization 
    266       !! -------------- 
    267       !! 
    268       i15 = nday / 16 
    269       iman  = INT( raamo ) 
    270       imois = nmonth + i15 - 1 
    271       IF( imois == 0 ) imois = iman 
    272       imois2 = nmonth 
    273  
    274       !! 1. first call kt=nittrc000 
    275       !! ----------------------- 
    276       !! 
    277       IF( kt == nittrc000 ) THEN 
    278          ! initializations 
    279          nflx1  = 0 
    280          nflx11 = 0 
    281          ! open the file 
    282          IF(lwp) THEN 
    283             WRITE(numout,*) ' ' 
    284             WRITE(numout,*) ' **** Routine trc_sed_medusa_sbc' 
     322      ! 
     323      IF( nn_timing == 1 )  CALL timing_start('trc_sed_medusa_sbc') 
     324      ! 
     325      !                            !* set file information 
     326      REWIND( numnatp_ref )        ! Namelist nammedsbc in reference namelist : MEDUSA external sources of Dust 
     327      READ  ( numnatp_ref, nammedsbc, IOSTAT = ios, ERR = 901) 
     328901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammedsbc in reference namelist', lwp ) 
     329 
     330      REWIND( numnatp_cfg )        ! Namelist nammedsbc in configuration namelist : MEDUSA external sources of Dust 
     331      READ  ( numnatp_cfg, nammedsbc, IOSTAT = ios, ERR = 902 ) 
     332902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammedsbc in configuration namelist', lwp ) 
     333      IF(lwm) WRITE ( numonp, nammedsbc ) 
     334 
     335      IF(lwp) THEN 
     336         WRITE(numout,*) ' ' 
     337         WRITE(numout,*) ' namelist : nammedsbc ' 
     338         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 
     339         WRITE(numout,*) '    dust input from the atmosphere           bdustfer     = ', bdustfer 
     340      END IF 
     341 
     342      ! dust input from the atmosphere 
     343      ! ------------------------------ 
     344      IF( bdustfer ) THEN 
     345         ! 
     346         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere ' 
     347         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
     348         ! 
     349         !! already allocated in sms_medusa 
     350         !!ALLOCATE( dust(jpi,jpj) )    ! allocation 
     351         ! 
     352         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     353         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trc_sed_medusa_sbc: unable to allocate sf_dust structure' ) 
     354         ! 
     355         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'trc_sed_medusa_sbc', 'Atmospheric dust deposition', 'nammedsed' ) 
     356                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   ) 
     357         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) ) 
     358         ! 
     359         IF( Agrif_Root() ) THEN   !  Only on the master grid 
     360            ! Get total input dust ; need to compute total atmospheric supply of Si in a year 
     361            CALL iom_open (  TRIM( sn_dust%clname ) , numdust ) 
     362            CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust)  ! get number of record in file 
     363            ALLOCATE( zdust(jpi,jpj,ntimes_dust) ) 
     364            DO jm = 1, ntimes_dust 
     365               CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm ) 
     366            END DO 
     367            CALL iom_close( numdust ) 
     368            DEALLOCATE( zdust) 
    285369         ENDIF 
    286          CALL iom_open ( 'dust.orca.nc', numdust ) 
    287     IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: dust.orca.nc opened' 
    288       ENDIF 
    289  
    290       !! Read monthly file 
    291       !! ---------------- 
    292       !! 
    293       IF( kt == nittrc000 .OR. imois /= nflx1 ) THEN 
    294  
    295          !! Calendar computation 
    296          !! 
    297          !! nflx1 number of the first file record used in the simulation 
    298          !! nflx2 number of the last  file record 
    299          !! 
    300          nflx1 = imois 
    301          nflx2 = nflx1+1 
    302          nflx1 = MOD( nflx1, iman ) 
    303          nflx2 = MOD( nflx2, iman ) 
    304          IF( nflx1 == 0 )   nflx1 = iman 
    305          IF( nflx2 == 0 )   nflx2 = iman 
    306          IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: first record file used nflx1 ',nflx1 
    307          IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: last  record file used nflx2 ',nflx2 
    308  
    309          !! Read monthly fluxes data 
    310          !! 
    311          !! humidity 
    312          !! 
    313          CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) 
    314          CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) 
    315  
    316          IF(lwp .AND. nitend-nit000 <= 100 ) THEN 
    317             WRITE(numout,*) 
    318             WRITE(numout,*) ' read clio flx ok' 
    319             WRITE(numout,*) 
    320             WRITE(numout,*) 
    321             WRITE(numout,*) 'Clio month: ',nflx1,'  field: dust' 
    322             CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout ) 
    323          ENDIF 
    324  
    325       ENDIF 
    326  
    327       !! 3. at every time step interpolation of fluxes 
    328       !! --------------------------------------------- 
    329       !! 
    330       zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 
    331       dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) ) 
    332  
    333       IF( kt == nitend ) THEN 
    334          CALL iom_close (numdust) 
    335          IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: dust.orca.nc closed' 
    336       ENDIF 
    337  
     370         ! 
     371         CALL fld_read( kt, 1, sf_dust ) 
     372         dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     373         ! 
     374      ELSE 
     375         dust(:,:) = 0.0 
     376      END IF 
     377      ! 
     378      IF( nn_timing == 1 )  CALL timing_stop('trc_sed_medusa_sbc') 
     379      ! 
    338380   END SUBROUTINE trc_sed_medusa_sbc 
    339381 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90

    r5726 r6639  
    2121   USE trcopt_medusa 
    2222   USE trcsed_medusa 
     23   USE trcavg_medusa 
    2324 
    2425 
    … …  
    4647      INTEGER, INTENT(in) :: kt   ! ocean time-step index 
    4748 
     49# if defined key_debug_medusa 
     50         IF(lwp) WRITE(numout,*) ' MEDUSA inside trc_sms_medusa' 
     51         CALL flush(numout) 
     52# endif 
     53 
    4854      IF( kt == nittrc000 ) THEN 
    4955       IF(lwp) WRITE(numout,*) 
    … …  
    5258      ENDIF 
    5359 
     60      CALL trc_avg_medusa( kt )   ! rolling average module 
     61# if defined key_debug_medusa 
     62         IF(lwp) WRITE(numout,*) ' MEDUSA done trc_avg_medusa' 
     63         CALL flush(numout) 
     64# endif 
     65 
    5466      CALL trc_opt_medusa( kt )   ! optical model 
     67# if defined key_debug_medusa 
     68         IF(lwp) WRITE(numout,*) ' MEDUSA done trc_opt_medusa' 
     69         CALL flush(numout) 
     70# endif 
    5571 
    5672# if defined key_kill_medusa 
    … …  
    6076# else 
    6177      CALL trc_bio_medusa( kt )   ! biological model 
     78# if defined key_debug_medusa 
     79         IF(lwp) WRITE(numout,*) ' MEDUSA done trc_bio_medusa' 
     80         CALL flush(numout) 
     81# endif 
    6282 
    6383      CALL trc_sed_medusa( kt )   ! sedimentation model 
     84# if defined key_debug_medusa 
     85         IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 
     86         CALL flush(numout) 
     87# endif 
    6488# endif 
    6589 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r6636 r6639  
    2727   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    2828   USE prtctl_trc      ! Print control 
     29   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2930 
    3031   IMPLICIT NONE 
    … …  
    7172      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7273      ! 
    73       INTEGER ::   jk  
     74      INTEGER ::   jk, jn  
    7475      CHARACTER (len=22) ::   charout 
    7576      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
    … …  
    105106      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    106107      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
     108      !  
     109      !! Jpalm -- 14-01-2016 -- restart and proc pb - try this...  
     110      DO jn = 1, jptra 
     111         CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
     112         CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 
     113      END DO 
     114      ! 
    107115 
    108116      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r6636 r6639  
    102102         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    103103 
    104          IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
    105             iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 
    106             IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 
    107             zfact = 0.5_wp 
    108             DO jn = 1, jptra 
    109                CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
    110             END DO 
    111          ELSE                                         ! No restart or restart not found: Euler forward time stepping 
     104         !! JPALM -- 12-01-2016 -- problem after restart, maybe because of this... 
     105         !!                     -- set sbc_trc_b to 0 after restart, first, to check. 
     106         !!------------------------------------------------------------------------------ 
     107        ! IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     108        !    iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 
     109        !    IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 
     110        !    zfact = 0.5_wp 
     111        !    DO jn = 1, jptra 
     112        !       CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
     113        !    END DO 
     114        ! ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    112115           zfact = 1._wp 
    113116           sbc_trc_b(:,:,:) = 0._wp 
    114         ENDIF 
     117        ! ENDIF 
    115118      ELSE                                         ! Swap of forcing fields 
    116119         IF( ln_top_euler ) THEN 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r6636 r6639  
    2727   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
    2828   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
     29# if defined key_debug_medusa 
     30   USE trcrst 
     31# endif 
     32 
    2933 
    3034#if defined key_agrif 
    … …  
    6569         ! 
    6670                                CALL trc_sbc( kstp )            ! surface boundary condition 
     71# if defined key_debug_medusa 
     72         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_sbc at kt =', kstp 
     73         CALL trc_rst_tra_stat 
     74         CALL flush(numout) 
     75# endif 
    6776         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
    6877         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    6978         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    7079                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
     80# if defined key_debug_medusa 
     81         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp 
     82         CALL trc_rst_tra_stat 
     83         CALL flush(numout) 
     84# endif 
    7185                                CALL trc_ldf( kstp )            ! lateral mixing 
    7286         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    … …  
    7690#endif 
    7791                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
     92# if defined key_debug_medusa 
     93         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp 
     94         CALL trc_rst_tra_stat 
     95         CALL flush(numout) 
     96# endif 
    7897                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
     98# if defined key_debug_medusa 
     99         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_nxt at kt =', kstp 
     100         CALL trc_rst_tra_stat 
     101         CALL flush(numout) 
     102# endif 
    79103         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
    80104 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r6637 r6639  
    88   !!             1.0  !  2004-03  (C. Ethe) Free form and module 
    99   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
     10   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2 
    1011   !!---------------------------------------------------------------------- 
    1112   USE par_kind          ! kind parameters 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r6636 r6639  
    104104   END TYPE DIAG 
    105105 
     106#if defined key_medusa && defined key_iomput 
     107   TYPE, PUBLIC :: BDIAG 
     108      LOGICAL              :: dgsave 
     109   END TYPE BDIAG 
     110    
     111   TYPE, PUBLIC :: DIAG_IOM 
     112      TYPE(BDIAG) INVTN, INVTSI, INVTFE, PRN, MPN, PRD, MPD, DSED, OPAL, OPALDISS, GMIPn,           & 
     113                  GMID, MZMI, GMEPN, GMEPD, GMEZMI, GMED, MZME, DEXP, DETN, MDET, AEOLIAN, BENTHIC, & 
     114                  SCAVENGE, PN_JLIM, PN_NLIM, PN_FELIM, PD_JLIM, PD_NLIM, PD_FELIM, PD_SILIM,       & 
     115                  PDSILIM2, SDT__100, SDT__200, SDT__500, SDT_1000, TOTREG_N, TOTRG_SI, REG__100,   & 
     116                  REG__200, REG__500, REG_1000, FASTN, FASTSI, FASTFE, FASTC, FASTCA, FDT__100,     & 
     117                  FDT__200, FDT__500, FDT_1000, RG__100F, RG__200F, RG__500F, RG_1000F, FDS__100,   & 
     118                  FDS__200, FDS__500, FDS_1000, RGS_100F, RGS_200F, RGS_500F, RGS1000F, REMINN,     & 
     119                  REMINSI, REMINFE, REMINC, REMINCA, SEAFLRN, SEAFLRSI, SEAFLRFE, SEAFLRC, SEAFLRCA, & 
     120                  MED_QSR, MED_XPAR, INTFLX_N, INTFLX_SI, INTFLX_FE, INT_PN, INT_PD, ML_PRN, ML_PRD, & 
     121                  OCAL_CCD, OCAL_LVL, FE_0000, FE_0100, FE_0200, FE_0500, FE_1000, MED_XZE, WIND,   & 
     122                  ATM_PCO2, OCN_PH, OCN_PCO2, OCNH2CO3, OCN_HCO3, OCN_CO3, CO2FLUX, OM_CAL, OM_ARG, & 
     123                  TCO2, TALK, KW660, ATM_PP0, O2FLUX, O2SAT, CAL_CCD, ARG_CCD, SFR_OCAL, SFR_OARG,  & 
     124                  N_PROD, N_CONS, C_PROD, C_CONS, O2_PROD, O2_CONS, O2_ANOX, RR_0100, RR_0500,      & 
     125                  RR_1000, IBEN_N, IBEN_FE, IBEN_C, IBEN_SI, IBEN_CA, OBEN_N, OBEN_FE, OBEN_C,      & 
     126                  OBEN_SI, OBEN_CA, BEN_N, BEN_FE, BEN_C, BEN_SI, BEN_CA, RUNOFF, RIV_N, RIV_SI,    & 
     127                  RIV_C, RIV_ALK, DETC, SDC__100, SDC__200, SDC__500, SDC_1000, INVTC, INVTALK,     & 
     128                  INVTO2, LYSO_CA, COM_RESP, PN_LLOSS, PD_LLOSS, ZI_LLOSS, ZE_LLOSS, ZI_MES_N,      & 
     129                  ZI_MES_D, ZI_MES_C, ZI_MESDC, ZI_EXCR, ZI_RESP, ZI_GROW, ZE_MES_N, ZE_MES_D,      & 
     130                  ZE_MES_C, ZE_MESDC, ZE_EXCR, ZE_RESP, ZE_GROW, MDETC, GMIDC, GMEDC,               & 
     131                  BASIN_01, BASIN_02, BASIN_03, BASIN_04, BASIN_05, BASIN_06, BASIN_07, BASIN_08,   & 
     132                  BASIN_09, BASIN_10, BASIN_11, BASIN_12, BASIN_13, BASIN_14, BASIN_15, BASIN_16,   & 
     133                  BASIN_17, BASIN_18, BASIN_19, BASIN_20, BASIN_21, BASIN_22, BASIN_23, BASIN_24,   & 
     134                  BASIN_25, BASIN_26, BASIN_27, BASIN_28, BASIN_29, BASIN_30, BASIN_31, BASIN_32,   & 
     135                  BASIN_33, BASIN_34, BASIN_35, BASIN_36, BASIN_37, BASIN_38, BASIN_39, BASIN_40,   & 
     136                  BASIN_41, BASIN_42, BASIN_43, BASIN_44, BASIN_45,                                 & 
     137                  INT_ZMI, INT_ZME, INT_DET, INT_DTC, DMS_SURF, DMS_ANDR, DMS_SIMO, DMS_ARAN,       & 
     138                  DMS_HALL,   & 
     139                  TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3       
     140                  !! list of all MEDUSA diagnostics that could be called by iom_use 
     141   END TYPE DIAG_IOM   
     142   !! 
     143   TYPE(DIAG_IOM), PUBLIC :: med_diag  ! define which diagnostics are asked in outputs 
     144# endif                    
     145 
    106146   !! information for inputs 
    107147   !! -------------------------------------------------- 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r6637 r6639  
    103103 
    104104      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
     105      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
     106      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
    105107      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    106108      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    107109      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
    108       IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
    109       IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
    110110 
    111111      CALL trc_ice_ini                                 ! Tracers in sea ice 
    … …  
    274274      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    275275      IF(lwp) CALL flush(numout) 
     276# if defined key_debug_medusa 
     277         CALL trc_rst_stat 
     278         CALL flush(numout) 
     279# endif 
    276280 
    2772819000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r6637 r6639  
    1111   !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes 
    1212   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     13   !!              -   !  2014-06  (A. Yool, J. Palmieri) adding MEDUSA-2 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_top 
    … …  
    5657      !! ** Method  : - read passive tracer namelist  
    5758      !!              - read namelist of each defined SMS model 
    58       !!                ( (PISCES, CFC, MY_TRC ) 
     59      !!                ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA ) 
    5960      !!--------------------------------------------------------------------- 
    6061      INTEGER  ::   jn, jk                     ! dummy loop indice 
    … …  
    235236      IF (lwp) write (numout,*) '------------------------------' 
    236237      IF (lwp) write (numout,*) 'Jpalm - debug' 
    237       IF (lwp) write (numout,*) 'CALL trc_nam_pisces -- OK' 
     238      IF (lwp) write (numout,*) 'CALL trc_nam_pisces  -- OK' 
    238239      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 
    239240      IF (lwp) write (numout,*) ' ' 
    … …  
    269270      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    270271      ENDIF 
    271  
     272      ! 
     273# if defined key_debug_medusa 
     274      CALL flush(numout) 
     275      IF (lwp) write (numout,*) '------------------------------' 
     276      IF (lwp) write (numout,*) 'Jpalm - debug' 
     277      IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 
     278      IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam OK' 
     279      IF (lwp) write (numout,*) ' ' 
     280# endif 
     281      ! 
    272282      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    273283      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    … …  
    277287      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    278288      ENDIF 
    279       ! 
     289        
    280290      IF(lwp)   CALL flush(numout) 
    281291   END SUBROUTINE trc_nam 
    … …  
    489499         trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' '  
    490500         ! 
     501      !! ELSE IF  ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN 
     502      !!    CALL trc_nam_iom_medusa 
    491503      ENDIF 
    492504 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r6637 r6639  
    2727   USE trcnam_trp 
    2828   USE iom 
     29   USE ioipsl, ONLY : ju2ymds    ! for calendar 
    2930   USE daymod 
    3031   !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 
    … …  
    3233   USE trcsms_medusa 
    3334   !! 
     35#if defined key_idtra 
     36   USE trcsms_idtra 
     37#endif 
     38   !! 
     39#if defined key_cfc 
     40   USE trcsms_cfc 
     41#endif 
     42   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     43 
    3444   IMPLICIT NONE 
    3545   PRIVATE 
    … …  
    3949   PUBLIC   trc_rst_wri       ! called by ??? 
    4050   PUBLIC   trc_rst_cal 
     51   PUBLIC   trc_rst_stat 
     52   PUBLIC   trc_rst_dia_stat 
     53   PUBLIC   trc_rst_tra_stat 
    4154 
    4255   !! * Substitutions 
    … …  
    5265      !!---------------------------------------------------------------------- 
    5366      INTEGER, INTENT(in) ::   kt       ! number of iteration 
     67      INTEGER             ::   iyear, imonth, iday 
     68      REAL (wp)           ::   zsec 
    5469      ! 
    5570      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    … …  
    8297      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
    8398      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
    84          ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    85          IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    86          ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
     99         IF ( ln_rstdate ) THEN 
     100            !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name 
     101            !!                     -- the condition to open the rst file is not the same than for the dynamic rst. 
     102            !!                     -- here it - for an obscure reason - is open 2 time-step before the restart writing process 
     103            !!                     instead of 1. 
     104            !!                     -- i am not sure if someone forgot +1 in the if loop condition as 
     105            !!                     it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is  
     106            !!                     nitrst - 2*nn_dttrc 
     107            !!                     -- nevertheless we didn't wanted to broke something already working  
     108            !!                     and just adapted the part we added. 
     109            !!                     -- So instead of calling ju2ymds( fjulday + (rdttra(1))  
     110            !!                     we call ju2ymds( fjulday + (2*rdttra(1))  
     111            !!--------------------------------------------------------------------       
     112            CALL ju2ymds( fjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec ) 
     113            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 
     114         ELSE 
     115            ! beware of the format used to write kt (default is i8.8, that should be large enough) 
     116            IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
     117            ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
     118            ENDIF 
    87119         ENDIF 
    88120         ! create the file 
    … …  
    105137      !! ** purpose  :   read passive tracer fields in restart files 
    106138      !!---------------------------------------------------------------------- 
    107       INTEGER  ::  jn      
     139      INTEGER  ::  jn, jl      
    108140      !! AXY (05/11/13): temporary variables 
    109141      REAL(wp) ::    fq0,fq1,fq2 
    … …  
    118150      DO jn = 1, jptra 
    119151         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
     152         trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:) 
    120153      END DO 
    121154 
    122155      DO jn = 1, jptra 
    123156         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    124       END DO 
    125  
     157         trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:) 
     158      END DO 
     159      ! 
    126160      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 
    127161      !!                 call to MEDUSA-2 at this point; this suggests that the FCM 
    … …  
    167201      !! calculate stats on these fields 
    168202      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
    169       fq0 = MINVAL(zn_sed_n(:,:)) 
    170       fq1 = MAXVAL(zn_sed_n(:,:)) 
    171       fq2 = SUM(zn_sed_n(:,:)) 
    172       if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', & 
    173          &        fq0, fq1, fq2 
    174       fq0 = MINVAL(zn_sed_fe(:,:)) 
    175       fq1 = MAXVAL(zn_sed_fe(:,:)) 
    176       fq2 = SUM(zn_sed_fe(:,:)) 
    177       if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', & 
    178          &        fq0, fq1, fq2 
    179       fq0 = MINVAL(zn_sed_si(:,:)) 
    180       fq1 = MAXVAL(zn_sed_si(:,:)) 
    181       fq2 = SUM(zn_sed_si(:,:)) 
    182       if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', & 
    183          &        fq0, fq1, fq2 
    184       fq0 = MINVAL(zn_sed_c(:,:)) 
    185       fq1 = MAXVAL(zn_sed_c(:,:)) 
    186       fq2 = SUM(zn_sed_c(:,:)) 
    187       if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', & 
    188          &        fq0, fq1, fq2 
    189       fq0 = MINVAL(zn_sed_ca(:,:)) 
    190       fq1 = MAXVAL(zn_sed_ca(:,:)) 
    191       fq2 = SUM(zn_sed_ca(:,:)) 
    192       if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', & 
    193          &        fq0, fq1, fq2 
    194 #endif 
    195   
     203      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N') 
     204      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 
     205      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 
     206      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 
     207      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 
     208      !! 
     209      !! AXY (07/07/15): read in temporally averaged fields for DMS 
     210      !!                 calculations 
     211      !! 
     212      IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN 
     213         !! YES; in which case read them 
     214         !! 
     215         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...' 
     216         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  ) 
     217         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  ) 
     218         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  ) 
     219         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  ) 
     220         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  ) 
     221         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  ) 
     222         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  ) 
     223         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  ) 
     224         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  ) 
     225         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  ) 
     226      ELSE 
     227         !! NO; in which case set them to zero 
     228         !! 
     229         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...' 
     230         zb_dms_chn(:,:)  = 0.0   !! CHN 
     231         zn_dms_chn(:,:)  = 0.0 
     232         zb_dms_chd(:,:)  = 0.0   !! CHD 
     233         zn_dms_chd(:,:)  = 0.0 
     234         zb_dms_mld(:,:)  = 0.0   !! MLD 
     235         zn_dms_mld(:,:)  = 0.0 
     236         zb_dms_qsr(:,:)  = 0.0   !! QSR 
     237         zn_dms_qsr(:,:)  = 0.0 
     238         zb_dms_din(:,:)  = 0.0   !! DIN 
     239         zn_dms_din(:,:)  = 0.0 
     240      ENDIF 
     241      !! 
     242      !! calculate stats on these fields 
     243      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 
     244      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 
     245      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 
     246      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 
     247      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 
     248      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 
     249#endif 
     250      ! 
     251#if defined key_idtra 
     252      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and  
     253      !!                        writting here undre their key. 
     254      !!                        problems in CFC restart, maybe because of this... 
     255      !!                        and pb in idtra diag or diad-restart writing. 
     256      !!---------------------------------------------------------------------- 
     257      IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN 
     258         !! YES; in which case read them 
     259         !! 
     260         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...' 
     261         CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA',  qint_idtra(:,:,1)  ) 
     262      ELSE 
     263         !! NO; in which case set them to zero 
     264         !! 
     265         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...' 
     266         qint_idtra(:,:,1)  = 0.0   !! CHN 
     267      ENDIF 
     268      !! 
     269      !! calculate stats on these fields 
     270      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 
     271      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 
     272#endif 
     273      ! 
     274#if defined key_cfc 
     275      DO jl = 1, jp_cfc 
     276         jn = jp_cfc0 + jl - 1 
     277         IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN 
     278            !! YES; in which case read them 
     279            !! 
     280            IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...' 
     281            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
     282         ELSE 
     283            !! NO; in which case set them to zero 
     284            !! 
     285            IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...' 
     286            qint_cfc(:,:,jn)  = 0.0   !! CHN 
     287         ENDIF 
     288         !! 
     289         !! calculate stats on these fields 
     290         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 
     291         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 
     292      END DO 
     293#endif 
    196294      ! 
    197295   END SUBROUTINE trc_rst_read 
    … …  
    205303      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    206304      !! 
    207       INTEGER  :: jn 
     305      INTEGER  :: jn, jl 
    208306      REAL(wp) :: zarak0 
    209307      !! AXY (05/11/13): temporary variables 
    … …  
    248346      !! calculate stats on these fields 
    249347      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
    250       fq0 = MINVAL(zn_sed_n(:,:)) 
    251       fq1 = MAXVAL(zn_sed_n(:,:)) 
    252       fq2 = SUM(zn_sed_n(:,:)) 
    253       if (lwp) write (numout,'(a,3f15.5)') 'Sediment  N ', & 
    254          &        fq0, fq1, fq2 
    255       fq0 = MINVAL(zn_sed_fe(:,:)) 
    256       fq1 = MAXVAL(zn_sed_fe(:,:)) 
    257       fq2 = SUM(zn_sed_fe(:,:)) 
    258       if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', & 
    259          &        fq0, fq1, fq2 
    260       fq0 = MINVAL(zn_sed_si(:,:)) 
    261       fq1 = MAXVAL(zn_sed_si(:,:)) 
    262       fq2 = SUM(zn_sed_si(:,:)) 
    263       if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', & 
    264          &        fq0, fq1, fq2 
    265       fq0 = MINVAL(zn_sed_c(:,:)) 
    266       fq1 = MAXVAL(zn_sed_c(:,:)) 
    267       fq2 = SUM(zn_sed_c(:,:)) 
    268       if (lwp) write (numout,'(a,3f15.5)') 'Sediment  C ', & 
    269          &        fq0, fq1, fq2 
    270       fq0 = MINVAL(zn_sed_ca(:,:)) 
    271       fq1 = MAXVAL(zn_sed_ca(:,:)) 
    272       fq2 = SUM(zn_sed_ca(:,:)) 
    273       if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', & 
    274          &        fq0, fq1, fq2 
    275 #endif 
    276  
    277       ! 
     348      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N') 
     349      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 
     350      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 
     351      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 
     352      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 
     353      !! 
     354      !! AXY (07/07/15): write out temporally averaged fields for DMS 
     355      !!                 calculations 
     356      !! 
     357      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...' 
     358      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN',  zb_dms_chn(:,:)  ) 
     359      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN',  zn_dms_chn(:,:)  ) 
     360      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD',  zb_dms_chd(:,:)  ) 
     361      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD',  zn_dms_chd(:,:)  ) 
     362      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD',  zb_dms_mld(:,:)  ) 
     363      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD',  zn_dms_mld(:,:)  ) 
     364      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR',  zb_dms_qsr(:,:)  ) 
     365      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR',  zn_dms_qsr(:,:)  ) 
     366      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN',  zb_dms_din(:,:)  ) 
     367      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN',  zn_dms_din(:,:)  ) 
     368      !! 
     369      !! calculate stats on these fields 
     370      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 
     371      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 
     372      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 
     373      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 
     374      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 
     375      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 
     376      !!  
     377#endif 
     378      ! 
     379#if defined key_idtra 
     380      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and  
     381      !!                        writting here undre their key. 
     382      !!                        problems in CFC restart, maybe because of this... 
     383      !!                        and pb in idtra diag or diad-restart writing. 
     384      !!---------------------------------------------------------------------- 
     385      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...' 
     386      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA',  qint_idtra(:,:,1) ) 
     387      !! 
     388      !! calculate stats on these fields 
     389      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 
     390      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 
     391#endif 
     392      ! 
     393#if defined key_cfc 
     394      DO jl = 1, jp_cfc 
     395         jn = jp_cfc0 + jl - 1 
     396         IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...' 
     397         CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
     398         !! 
     399         !! calculate stats on these fields 
     400         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 
     401         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 
     402      END DO 
     403#endif 
     404      ! 
     405 
    278406      IF( kt == nitrst ) THEN 
    279407          CALL trc_rst_stat            ! statistics 
    … …  
    437565         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 
    438566      END DO 
    439       WRITE(numout,*)  
     567      IF(lwp) WRITE(numout,*)  
    4405689000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
    441569      &      '    max :',e18.10,'    drift :',e18.10, ' %') 
    442570      ! 
    443571   END SUBROUTINE trc_rst_stat 
     572 
     573 
     574   SUBROUTINE trc_rst_tra_stat 
     575      !!---------------------------------------------------------------------- 
     576      !!                    ***  trc_rst_tra_stat  *** 
     577      !! 
     578      !! ** purpose  :   Compute tracers statistics - check where crazy values appears 
     579      !!---------------------------------------------------------------------- 
     580      INTEGER  :: jk, jn 
     581      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
     582      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     583      !!---------------------------------------------------------------------- 
     584 
     585      IF( lwp ) THEN 
     586         WRITE(numout,*) 
     587         WRITE(numout,*) '           ----SURFACE TRA STAT----             ' 
     588         WRITE(numout,*) 
     589      ENDIF 
     590      ! 
     591         zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
     592      DO jn = 1, jptra 
     593         ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 
     594         zmin  = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
     595         zmax  = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
     596         IF( lk_mpp ) THEN 
     597            CALL mpp_min( zmin )      ! min over the global domain 
     598            CALL mpp_max( zmax )      ! max over the global domain 
     599         END IF 
     600         zmean  = ztraf / areatot 
     601         IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 
     602      END DO 
     603      IF(lwp) WRITE(numout,*) 
     6049001  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     605      &      '    max :',e18.10) 
     606      ! 
     607   END SUBROUTINE trc_rst_tra_stat 
     608 
     609 
     610 
     611   SUBROUTINE trc_rst_dia_stat( dgtr, names) 
     612      !!---------------------------------------------------------------------- 
     613      !!                    ***  trc_rst_dia_stat  *** 
     614      !! 
     615      !! ** purpose  :   Compute tracers statistics 
     616      !!---------------------------------------------------------------------- 
     617      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var 
     618      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name 
     619      !!--------------------------------------------------------------------- 
     620      INTEGER  :: jk, jn 
     621      REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 
     622      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     623      !!---------------------------------------------------------------------- 
     624 
     625      IF( lwp )  WRITE(numout,*) 'STAT- ', names 
     626      ! 
     627      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
     628      ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 
     629      areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 
     630      zmin  = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
     631      zmax  = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
     632      IF( lk_mpp ) THEN 
     633         CALL mpp_min( zmin )      ! min over the global domain 
     634         CALL mpp_max( zmax )      ! max over the global domain 
     635      END IF 
     636      zmean  = ztraf / areatot 
     637      IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 
     638      ! 
     639      IF(lwp) WRITE(numout,*) 
     6409002  FORMAT(' tracer name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     641      &      '    max :',e18.10 ) 
     642      ! 
     643   END SUBROUTINE trc_rst_dia_stat 
     644 
    444645 
    445646#else 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r6637 r6639  
    4545      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    4646      !! 
     47      INTEGER            ::  jn 
    4748      CHARACTER (len=25) :: charout 
    4849      !!--------------------------------------------------------------------- 
    … …  
    5253      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
    5354      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers 
     55# if defined key_debug_medusa 
     56         IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK --  next IDTRA -- ' 
     57      CALL flush(numout) 
     58# endif 
    5459      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer 
     60# if defined key_debug_medusa 
     61         IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK --  next CFC -- ' 
     62      CALL flush(numout) 
     63# endif 
    5564      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
     65# if defined key_debug_medusa 
     66         IF(lwp) WRITE(numout,*) '--trcsms : CFC OK --  continue -- ' 
     67      CALL flush(numout) 
     68# endif 
    5669      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
    5770      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r6637 r6639  
    9292# endif 
    9393                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
     94# if defined key_debug_medusa 
     95                                   CALL trc_rst_stat  
     96                                   CALL trc_rst_tra_stat 
     97# endif 
    9498         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    9599         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
    … …  
    99103# if defined key_debug_medusa 
    100104         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 
     105         CALL trc_rst_stat 
     106         CALL trc_rst_tra_stat 
    101107         CALL flush(numout) 
    102108# endif 
    … …  
    104110# if defined key_debug_medusa 
    105111         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 
     112         CALL trc_rst_stat 
     113         CALL trc_rst_tra_stat 
    106114         CALL flush(numout) 
    107115# endif 

  • branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r6637 r6639  
    55   !!====================================================================== 
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
     7   !!              -   !  2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_top && defined key_iomput 
    … …  
    2223   USE trcwri_my_trc 
    2324   USE trcwri_medusa 
     25   USE trcwri_idtra 
    2426 
    2527   IMPLICIT NONE 
    … …  
    5860      ! --------------------------------------- 
    5961      IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES  
     62      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
     63      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
     64      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
    6065      ! 
    6166# if defined key_debug_medusa 
    … …  
    7984# endif 
    8085      ! 
    81       !!! JPALM 
    82       !!! don't forget to add idtra  
    83       IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    84       IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
    85       IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     86      IF( lk_idtra   )   CALL trc_wri_idtra       ! Idealize tracers 
     87      ! 
     88# if defined key_debug_medusa 
     89      CALL flush(numout) 
     90      IF (lwp) write (numout,*) '------------------------------' 
     91      IF (lwp) write (numout,*) 'Jpalm - debug' 
     92      IF (lwp) write (numout,*) 'CALL trc_wri_idtra -- OK' 
     93      IF (lwp) write (numout,*) ' ' 
     94      CALL flush(numout) 
     95# endif 
    8696      ! 
    8797      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
Note: See TracChangeset for help on using the changeset viewer.