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

Changeset 8155


Ignore:
Timestamp:
2017-06-08T14:44:59+02:00 (7 years ago)
Author:
frrh
Message:

Merge branches/NERC/dev_r5518_NOC_MEDUSA_Stable revisions 5711:8147, thus
svn merge -r 5711:8147.

We also resolve conflicts by hand, typically relating to retaining files
in the AGRIF direcories. Nothing in main OPA_SRC aor TOP_SRC code.

Location:
branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM
Files:
20 edited
43 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/CONFIG/SHARED/namelist_cfc_ref

    r4147 r8155  
    77!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    88   ndate_beg  = 300101    !  datedeb1 
    9    nyear_res  = 1932      !  iannee1 
     9   nyear_res  = 1600      !  iannee1 
     10   simu_type  = 1         ! kind of Simulation: 1 = SPIN-UP (90y-cycle) 
     11!!                                           !! 2 = Hindcast/proj (100y cycle) 
    1012/ 
    1113!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/CONFIG/cfg.txt

    r6498 r8155  
    1111GYRE OPA_SRC 
    1212ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
     13ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
     14ORCA2_OFF_MEDUSA OPA_SRC OFF_SRC TOP_SRC 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90

    r6486 r8155  
     1#if ! defined key_top 
    12MODULE trdtrc 
    23   !!====================================================================== 
     
    2223   !!====================================================================== 
    2324END MODULE trdtrc 
     25#endif 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r7563 r8155  
    7474#if defined key_top 
    7575   USE trcini          ! passive tracer initialisation 
     76   USE trc, ONLY: numstr  ! tracer stats unit number 
    7677#endif 
    7778   USE lib_mpp         ! distributed memory computing 
     
    609610      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports 
    610611      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports 
     612      IF( numstr          /= -1 )   CLOSE( numstr          )   ! tracer statistics  
    611613 
    612614      ! 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    r6486 r8155  
    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_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r6486 r8155  
    55   !!====================================================================== 
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
     7   !!                  !  2017-04  (A. Yool)  add SF6 
    78   !!---------------------------------------------------------------------- 
    89   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    1516   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    1617 
     18   USE par_medusa , ONLY : jp_medusa       !: number of tracers in MEDUSA 
     19   USE par_medusa , ONLY : jp_medusa_2d    !: number of 2D diag in MEDUSA 
     20   USE par_medusa , ONLY : jp_medusa_3d    !: number of 3D diag in MEDUSA 
     21   USE par_medusa , ONLY : jp_medusa_trd   !: number of biological diag in MEDUSA 
     22 
     23   USE par_idtra  , ONLY : jp_idtra        !: number of tracers in ideal tracer 
     24   USE par_idtra  , ONLY : jp_idtra_2d     !: number of tracers in ideal tracer 
     25   USE par_idtra  , ONLY : jp_idtra_3d     !: number of tracers in ideal tracer 
     26   USE par_idtra  , ONLY : jp_idtra_trd    !: number of tracers in ideal tracer 
     27 
    1728   IMPLICIT NONE 
    1829 
    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 !: 
     30   INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     + jp_medusa     + & 
     31                      jp_idtra     !: cumulative number of passive tracers 
     32   INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  + jp_medusa_2d  + & 
     33                      jp_idtra_2d !: 
     34   INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  + jp_medusa_3d  + & 
     35                      jp_idtra_3d !: 
     36   INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd + jp_medusa_trd + & 
     37                      jp_idtra_trd !: 
    2338    
    2439#if defined key_cfc 
     
    2742   !!--------------------------------------------------------------------- 
    2843   LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .TRUE.      !: CFC flag  
    29    INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  1          !: number of passive tracers 
    30    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  2          !: additional 2d output arrays ('key_trc_diaadd') 
     44   INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  3          !: number of passive tracers 
     45   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  6          !: additional 2d output arrays ('key_trc_diaadd') 
    3146   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd') 
    3247   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC 
     
    3449   ! assign an index in trc arrays for each CFC prognostic variables 
    3550   INTEGER, PUBLIC, PARAMETER ::   jpc11       = jp_lc + 1   !: CFC-11  
    36    INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12    
     51   INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12 (priority tracer for CMIP6) 
     52   INTEGER, PUBLIC, PARAMETER ::   jpsf6       = jp_lc + 3   !: SF6 
    3753#else 
    3854   !!--------------------------------------------------------------------- 
     
    4763 
    4864   ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done) 
    49    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1       !: First index of CFC tracers 
    50    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc  !: Last  index of CFC tracers 
    51    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1       !: First index of CFC tracers 
     65   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1              !: First index of CFC tracers 
     66   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc         !: Last  index of CFC tracers 
     67   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1          !: First index of CFC tracers 
    5268   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_2d  = jp_lc_2d  + jp_cfc_2d  !: Last  index of CFC tracers 
    53    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1       !: First index of CFC tracers 
     69   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1          !: First index of CFC tracers 
    5470   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_3d  = jp_lc_3d  + jp_cfc_3d  !: Last  index of CFC tracers 
    55    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1       !: First index of CFC tracers 
    56    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd  !: Last  index of CFC tracers 
     71   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1          !: First index of CFC tracers 
     72   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd !: Last  index of CFC tracers 
    5773 
    5874   !!====================================================================== 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r6486 r8155  
    55   !!====================================================================== 
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  
     7   !!                  !  2017-04  (A. Yool)  Add SF6 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_cfc 
     
    2223   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module 
    2324 
    24    CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ??? 
     25   CHARACTER (len=34) ::   clname = 'cfc1112sf6.atm'   ! ??? 
    2526 
    2627   INTEGER  ::   inum                   ! unit number 
     
    4445      !!---------------------------------------------------------------------- 
    4546      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr 
    46       INTEGER  ::  iskip = 6   ! number of 1st descriptor lines 
     47      INTEGER  ::  iskip = 7   ! number of 1st descriptor lines 
    4748      REAL(wp) ::  zyy, zyd 
    4849      !!---------------------------------------------------------------------- 
     
    5354 
    5455 
    55       IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm' 
     56      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112sf6.atm' 
    5657       
    5758      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     
    6970      !                                ! Allocate CFC arrays 
    7071 
    71       ALLOCATE( p_cfc(jpyear,jphem,2), STAT=ierr ) 
     72      ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr ) 
    7273      IF( ierr > 0 ) THEN 
    7374         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN 
     
    9091         ENDIF 
    9192         qint_cfc(:,:,:) = 0._wp 
    92          DO jl = 1, jp_cfc 
    93             jn = jp_cfc0 + jl - 1 
    94             trn(:,:,:,jn) = 0._wp 
    95          END DO 
     93         trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
    9694      ENDIF 
    9795 
     
    105103      jn = 31 
    106104      DO  
    107         READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
     105        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), & 
     106             & p_cfc(jn,1,3), p_cfc(jn,2,1),  & 
     107             & p_cfc(jn,2,2), p_cfc(jn,2,3) 
    108108        IF( io < 0 ) exit 
    109109        jn = jn + 1 
    110110      END DO 
    111111 
    112       p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
    113       p_cfc(33,1:2,1) = 8.e-4 
    114       p_cfc(34,1:2,1) = 1.e-6 
    115       p_cfc(35,1:2,1) = 2.e-3 
    116       p_cfc(36,1:2,1) = 4.e-3 
    117       p_cfc(37,1:2,1) = 6.e-3 
    118       p_cfc(38,1:2,1) = 8.e-3 
    119       p_cfc(39,1:2,1) = 1.e-2 
     112      ! AXY (25/04/17): do not adjust 
     113      ! p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
     114      ! p_cfc(33,1:2,1) = 8.e-4 
     115      ! p_cfc(34,1:2,1) = 1.e-6 
     116      ! p_cfc(35,1:2,1) = 2.e-3 
     117      ! p_cfc(36,1:2,1) = 4.e-3 
     118      ! p_cfc(37,1:2,1) = 6.e-3 
     119      ! p_cfc(38,1:2,1) = 8.e-3 
     120      ! p_cfc(39,1:2,1) = 1.e-2 
    120121       
    121122      IF(lwp) THEN        ! Control print 
    122123         WRITE(numout,*) 
    123          WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS ' 
     124         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS    pSF6N    pSF6S ' 
    124125         DO jn = 30, jpyear 
    125             WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 
     126            WRITE(numout, '( 1I4, 6F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), & 
     127                 & p_cfc(jn,1,2), p_cfc(jn,2,2), & 
     128                 & p_cfc(jn,1,3), p_cfc(jn,2,3) 
    126129         END DO 
    127130      ENDIF 
    128  
    129131 
    130132      ! Interpolation factor of atmospheric partial pressure 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r6486 r8155  
    4949      TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 
    5050      !! 
    51       NAMELIST/namcfcdate/ ndate_beg, nyear_res 
     51      NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type  
    5252      NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics 
    5353      !!---------------------------------------------------------------------- 
     
    7272         WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg 
    7373         WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res 
     74         IF (simu_type==1) THEN 
     75            WRITE(numout,*) ' CFC running on SPIN-UP mode             simu_type = ', simu_type 
     76         ELSEIF (simu_type==2) THEN 
     77            WRITE(numout,*) ' CFC running on HINDCAST/PROJECTION mode simu_type = ', simu_type 
     78         ENDIF 
    7479      ENDIF 
    7580      nyear_beg = ndate_beg / 10000 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r6486 r8155  
    77   !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity 
    88   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
     9   !!                 !  2016-06  (J. Palmieri)  update for UKESM1 
     10   !!                 !  2017-04  (A. Yool)  update to add SF6, fix coefficients 
    911   !!---------------------------------------------------------------------- 
    1012#if defined key_cfc 
     
    1517   !!   cfc_init     :  sets constants for CFC surface forcing computation 
    1618   !!---------------------------------------------------------------------- 
     19   USE dom_oce       ! ocean space and time domain 
    1720   USE oce_trc       ! Ocean variables 
    1821   USE par_trc       ! TOP parameters 
     
    3134   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file 
    3235   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
     36   INTEGER , PUBLIC            ::   simu_type      ! Kind of simulation: 1- Spin-up  
     37                                                   !                     2- Hindcast/projection 
    3338   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year) 
    3439   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)  
     
    4045   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function 
    4146 
    42    REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
    43    REAL(wp), DIMENSION(3,2) ::   sob   !    "               " 
    44    REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius 
     47   REAL(wp), DIMENSION(4,3) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
     48   REAL(wp), DIMENSION(3,3) ::   sob   !    "               " 
     49   REAL(wp), DIMENSION(5,3) ::   sca   ! coefficients for schmidt number in degre Celcius 
    4550       
    4651   !                          ! coefficients for conversion 
     
    7984      ! 
    8085      INTEGER  ::   ji, jj, jn, jl, jm, js 
    81       INTEGER  ::   iyear_beg, iyear_end 
     86      INTEGER  ::   iyear_beg, iyear_end, iyear_tmp 
    8287      INTEGER  ::   im1, im2, ierr 
    8388      REAL(wp) ::   ztap, zdtap         
    84       REAL(wp) ::   zt1, zt2, zt3, zv2 
     89      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2 
    8590      REAL(wp) ::   zsol      ! solubility 
    8691      REAL(wp) ::   zsch      ! schmidt number  
     
    103108      ! Temporal interpolation 
    104109      ! ---------------------- 
    105       iyear_beg = nyear - 1900 
     110      !! JPALM -- 15-06-2016 -- define 2 kinds of CFC run: 
     111      !!                     1- the SPIN-UP and 2- Hindcast/Projections 
     112      !!                     -- main difference is the way to define the year of 
     113      !!                     simulation, that determine the atm pCFC. 
     114      !!                     1-- Spin-up: our atm forcing is of 30y we cycle on. 
     115      !!                     So we do 90y CFC cycles to be in good 
     116      !!                     correspondence with the atmosphere 
     117      !!                     2-- Hindcast/proj, instead of nyear-1900 we keep 
     118      !!                     the 2 last digit, and enable 3 cycle from 1800 to 2100.   
     119      !!---------------------------------------------------------------------- 
     120      IF (simu_type==1) THEN 
     121         !! 1 -- SPIN-UP 
     122         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000 
     123         iyear_beg = MOD( iyear_tmp , 90 ) 
     124         !! JPALM -- the pCFC file only got 78 years. 
     125         !!       So if iyear_beg > 78 then we set pCFC to 0 
     126         !!             iyear_beg = 0 as well -- must try to avoid obvious problems 
     127         !!             as Pcfc is set to 0.00 up to year 32, let set iyear_beg to year 10 
     128         !!          else, must add 30 to iyear_beg to match with P_cfc indices 
     129         !!--------------------------------------- 
     130         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 
     131            iyear_beg = 10 
     132         ELSE  
     133            iyear_beg = iyear_beg + 30 
     134         ENDIF 
     135      ELSEIF (simu_type==2) THEN 
     136         !! 2 -- Hindcast/proj 
     137         iyear_beg = MOD(nyear, 100) 
     138         IF (iyear_beg < 20)  iyear_beg = iyear_beg + 100 
     139         !! JPALM -- Same than previously, if iyear_beg is out of P_cfc range, 
     140         !!       we want to set p_CFC to 0.00 --> set iyear_beg = 10 
     141         IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) iyear_beg = 10              
     142      ENDIF 
     143      !! 
    106144      IF ( nmonth <= 6 ) THEN 
    107145         iyear_beg = iyear_beg - 1 
     
    152190               zt2  = zt1 * zt1  
    153191               zt3  = zt1 * zt2 
    154                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 
     192               zt4  = zt1 * zt3 
     193               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
    155194 
    156195               !    speed transfert : formulae of wanninkhof 1992 
    157196               zv2     = wndm(ji,jj) * wndm(ji,jj) 
    158197               zsch    = zsch / 660. 
    159                zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     198               ! AXY (25/04/17): OMIP protocol specifies lower Wanninkhof (2014) value 
     199               ! zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     200               zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    160201 
    161202               ! Input function  : speed *( conc. at equil - concen at surface ) 
     
    176217         !                                                  !----------------! 
    177218      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                                             
     219         ! 
     220      IF( kt == nittrc000 ) THEN 
     221         DO jl = 1, jp_cfc    
     222             WRITE(NUMOUT,*) ' ' 
     223             WRITE(NUMOUT,*) 'CFC interpolation verification '  !! Jpalm   
     224             WRITE(NUMOUT,*) '################################## ' 
     225             WRITE(NUMOUT,*) ' ' 
     226               if (jl.EQ.1) then 
     227                   WRITE(NUMOUT,*) 'Traceur = CFC11: ' 
     228               elseif (jl.EQ.2) then 
     229                   WRITE(NUMOUT,*) 'Traceur = CFC12: ' 
     230               elseif (jl.EQ.3) then 
     231                   WRITE(NUMOUT,*) 'Traceur = SF6: ' 
     232               endif 
     233             WRITE(NUMOUT,*) 'nyear    = ', nyear 
     234             WRITE(NUMOUT,*) 'nmonth   = ', nmonth 
     235             WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg 
     236             WRITE(NUMOUT,*) 'iyear_end= ', iyear_end 
     237             WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl) 
     238             WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl) 
     239             WRITE(NUMOUT,*) 'Im1= ',im1 
     240             WRITE(NUMOUT,*) 'Im2= ',im2 
     241             WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc 
     242             WRITE(NUMOUT,*) ' ' 
     243         END DO   
     244# if defined key_debug_medusa 
     245         CALL flush(numout) 
     246# endif 
     247      ENDIF 
     248        ! 
     249      !IF( lrst_trc ) THEN 
     250      !   IF(lwp) WRITE(numout,*) 
     251      !   IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   & 
     252      !      &                    'at it= ', kt,' date= ', ndastp 
     253      !   IF(lwp) WRITE(numout,*) '~~~~' 
     254      !   DO jn = jp_cfc0, jp_cfc1 
     255      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
     256      !   END DO 
     257      !ENDIF                                             
    188258      ! 
    189259      IF( lk_iomput ) THEN 
    190          CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    191          CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     260         IF  (iom_use("qtrCFC11"))  CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
     261         IF  (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     262         IF  (iom_use("qtrCFC12"))  CALL iom_put( "qtrCFC12"  , qtr_cfc (:,:,2) ) 
     263         IF  (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 
     264         IF  (iom_use("qtrSF6"))    CALL iom_put( "qtrSF6"    , qtr_cfc (:,:,3) ) 
     265         IF  (iom_use("qintSF6"))   CALL iom_put( "qintSF6"   , qint_cfc(:,:,3) ) 
    192266      ELSE 
    193267         IF( ln_diatrc ) THEN 
    194268            trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    195269            trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
     270            trc2d(:,:,jp_cfc0_2d + 2) = qtr_cfc (:,:,2) 
     271            trc2d(:,:,jp_cfc0_2d + 3) = qint_cfc(:,:,2) 
     272            trc2d(:,:,jp_cfc0_2d + 4) = qtr_cfc (:,:,3) 
     273            trc2d(:,:,jp_cfc0_2d + 5) = qint_cfc(:,:,3) 
    196274         END IF 
    197275      END IF 
     
    203281      END IF 
    204282      ! 
     283# if defined key_debug_medusa 
     284      IF(lwp) WRITE(numout,*) '   CFC - Check: nn_timing = ', nn_timing 
     285      CALL flush(numout) 
     286# endif 
    205287      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc') 
    206288      ! 
     
    214296      !! ** Purpose : sets constants for CFC model 
    215297      !!--------------------------------------------------------------------- 
    216       INTEGER :: jn 
     298      INTEGER :: jl, jn, iyear_beg, iyear_tmp 
    217299 
    218300      ! coefficient for CFC11  
     
    223305      soa(2,1) =  319.6552 
    224306      soa(3,1) =  119.4471 
    225       soa(4,1) =  -1.39165 
    226  
    227       sob(1,1) =  -0.142382 
    228       sob(2,1) =   0.091459 
    229       sob(3,1) =  -0.0157274 
    230  
    231       ! Schmidt number  
    232       sca(1,1) = 3501.8 
    233       sca(2,1) = -210.31 
    234       sca(3,1) =  6.1851 
    235       sca(4,1) = -0.07513 
     307      soa(4,1) =   -1.39165 
     308 
     309      sob(1,1) = -0.142382 
     310      sob(2,1) =  0.091459 
     311      sob(3,1) = -0.0157274 
     312 
     313      ! Schmidt number          AXY (25/04/17) 
     314      sca(1,1) = 3579.2       ! = 3501.8 
     315      sca(2,1) = -222.63      ! = -210.31 
     316      sca(3,1) =    7.5749    ! =    6.1851 
     317      sca(4,1) =   -0.14595   ! =   -0.07513 
     318      sca(5,1) =    0.0011874 ! = absent 
    236319 
    237320      ! coefficient for CFC12  
     
    242325      soa(2,2) =  298.9702 
    243326      soa(3,2) =  113.8049 
    244       soa(4,2) =  -1.39165 
    245  
    246       sob(1,2) =  -0.143566 
    247       sob(2,2) =   0.091015 
    248       sob(3,2) =  -0.0153924 
    249  
    250       ! schmidt number  
    251       sca(1,2) =  3845.4  
    252       sca(2,2) =  -228.95 
    253       sca(3,2) =  6.1908  
    254       sca(4,2) =  -0.067430 
    255  
    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 
     327      soa(4,2) =   -1.39165 
     328 
     329      sob(1,2) = -0.143566 
     330      sob(2,2) =  0.091015 
     331      sob(3,2) = -0.0153924 
     332 
     333      ! schmidt number         AXY (25/04/17) 
     334      sca(1,2) = 3828.1      ! = 3845.4  
     335      sca(2,2) = -249.86     ! = -228.95 
     336      sca(3,2) =    8.7603   ! =    6.1908  
     337      sca(4,2) =   -0.1716   ! =   -0.067430 
     338      sca(5,2) =    0.001408 ! = absent 
     339 
     340      ! coefficients for SF6   AXY (25/04/17) 
     341      !--------------------- 
     342       
     343      ! Solubility 
     344      soa(1,3) =  -80.0343 
     345      soa(2,3) =  117.232 
     346      soa(3,3) =   29.5817 
     347      soa(4,3) =    0.0 
     348 
     349      sob(1,3) =  0.0335183 
     350      sob(2,3) = -0.0373942 
     351      sob(3,3) =  0.00774862 
     352 
     353      ! Schmidt number 
     354      sca(1,3) = 3177.5 
     355      sca(2,3) = -200.57 
     356      sca(3,3) =    6.8865 
     357      sca(4,3) =   -0.13335 
     358      sca(5,3) =    0.0010877 
     359 
     360      !!--------------------------------------------- 
     361      !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle, 
     362      !!       Or if out of P_cfc range 
     363      IF (simu_type==1) THEN 
     364         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000 
     365         iyear_beg = MOD( iyear_tmp , 90 ) 
     366         !!--------------------------------------- 
     367         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 
     368            qtr_cfc(:,:,:) = 0._wp 
     369            IF(lwp) THEN 
     370               WRITE(numout,*)  
     371               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 
     372               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --' 
     373               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --' 
     374               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --' 
     375            ENDIF 
     376            qtr_cfc(:,:,:) = 0._wp 
     377            qint_cfc(:,:,:) = 0._wp 
     378            trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
     379            trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
     380         ENDIF 
     381      !! 
     382      !! 2 -- Hindcast/proj 
     383      ELSEIF (simu_type==2) THEN 
     384         iyear_beg = MOD(nyear, 100) 
     385         IF (iyear_beg < 20)  iyear_beg = iyear_beg + 100 
     386         IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) THEN 
     387            qtr_cfc(:,:,:) = 0._wp 
     388            IF(lwp) THEN 
     389               WRITE(numout,*) 
     390               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 
     391               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --' 
     392               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --' 
     393               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --' 
     394            ENDIF 
     395            qtr_cfc(:,:,:) = 0._wp 
     396            qint_cfc(:,:,:) = 0._wp 
     397            trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
     398            trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 
     399         ENDIF 
    264400      ENDIF 
     401 
    265402      IF(lwp) WRITE(numout,*) 
    266403      ! 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r7203 r8155  
    2929   USE trdtra 
    3030   USE prtctl_trc      ! Print control 
     31   !! USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3132 
    3233   IMPLICIT NONE 
     
    7374      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7475      ! 
    75       INTEGER ::   jk  
     76      INTEGER ::   jk, jn  
    7677      CHARACTER (len=22) ::   charout 
    7778      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
     
    108109      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    109110      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
     111      !  
     112      !! Jpalm -- 14-01-2016 -- restart and proc pb - try this...  
     113      !! DO jn = 1, jptra 
     114      !!   CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
     115      !!   CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 
     116      !! END DO 
     117      ! 
    110118 
    111119      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r6498 r8155  
    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_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r6498 r8155  
    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                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
     79# if defined key_debug_medusa 
     80         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp 
     81         CALL trc_rst_tra_stat 
     82         CALL flush(numout) 
     83# endif 
    7084                                CALL trc_ldf( kstp )            ! lateral mixing 
    7185         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
     
    7589#endif 
    7690                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
     91# if defined key_debug_medusa 
     92         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp 
     93         CALL trc_rst_tra_stat 
     94         CALL flush(numout) 
     95# endif 
    7796                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
     97# if defined key_debug_medusa 
     98         IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_nxt at kt =', kstp 
     99         CALL trc_rst_tra_stat 
     100         CALL flush(numout) 
     101# endif 
    78102         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
    79103         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r7203 r8155  
    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 
     
    1516   USE par_cfc       ! CFC 11 and 12 tracers 
    1617   USE par_my_trc    ! user defined passive tracers 
     18   USE par_medusa    ! MEDUSA model 
     19   USE par_idtra     ! Idealize tracer 
     20   USE par_age       ! AGE  tracer 
    1721 
    1822   IMPLICIT NONE 
     
    2428   ! Passive tracers : Total size 
    2529   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    26    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
    27    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
    28    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     30   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc    + jp_medusa    + jp_idtra     + jp_age 
     31   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d  + jp_age_2d 
     32   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d  + jp_age_3d 
    2933   !                     ! total number of sms diagnostic arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     34   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd + jp_age_trd 
    3135    
    3236   !  1D configuration ("key_c1d") 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r6486 r8155  
    77   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    88   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module 
     9   !!             3.6  !  2016-11  (A. Yool)  Updated diags for CMIP6 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_top 
     
    2526   INTEGER, PUBLIC                                                 ::   numnat_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg 
    2627   INTEGER, PUBLIC                                                 ::   numont     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top 
    27    INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics 
     28   INTEGER, PUBLIC                                                 ::   numstr     = -1   !: logical unit for tracer statistics 
    2829   INTEGER, PUBLIC                                                 ::   numrtr        !: logical unit for trc restart (read ) 
    2930   INTEGER, PUBLIC                                                 ::   numrtw        !: logical unit for trc restart ( write ) 
     
    104105   END TYPE DIAG 
    105106 
     107#if defined key_medusa && defined key_iomput 
     108   TYPE, PUBLIC :: BDIAG 
     109      LOGICAL              :: dgsave 
     110   END TYPE BDIAG 
     111    
     112   TYPE, PUBLIC :: DIAG_IOM 
     113      TYPE(BDIAG) INVTN, INVTSI, INVTFE, PRN, MPN, PRD, MPD, DSED, OPAL, OPALDISS, GMIPn,            & 
     114                  GMID, MZMI, GMEPN, GMEPD, GMEZMI, GMED, MZME, DEXP, DETN, MDET, AEOLIAN, BENTHIC,  & 
     115                  SCAVENGE, PN_JLIM, PN_NLIM, PN_FELIM, PD_JLIM, PD_NLIM, PD_FELIM, PD_SILIM,        & 
     116                  PDSILIM2, SDT__100, SDT__200, SDT__500, SDT_1000, TOTREG_N, TOTRG_SI, REG__100,    & 
     117                  REG__200, REG__500, REG_1000, FASTN, FASTSI, FASTFE, FASTC, FASTCA, FDT__100,      & 
     118                  FDT__200, FDT__500, FDT_1000, RG__100F, RG__200F, RG__500F, RG_1000F, FDS__100,    & 
     119                  FDS__200, FDS__500, FDS_1000, RGS_100F, RGS_200F, RGS_500F, RGS1000F, REMINN,      & 
     120                  REMINSI, REMINFE, REMINC, REMINCA, SEAFLRN, SEAFLRSI, SEAFLRFE, SEAFLRC, SEAFLRCA, & 
     121                  MED_QSR, MED_XPAR, INTFLX_N, INTFLX_SI, INTFLX_FE, INT_PN, INT_PD, ML_PRN, ML_PRD, & 
     122                  OCAL_CCD, OCAL_LVL, FE_0000, FE_0100, FE_0200, FE_0500, FE_1000, MED_XZE, WIND,    & 
     123                  ATM_PCO2, OCN_PH, OCN_PCO2, OCNH2CO3, OCN_HCO3, OCN_CO3, CO2FLUX, OM_CAL, OM_ARG,  & 
     124                  TCO2, TALK, KW660, ATM_PP0, O2FLUX, O2SAT, CAL_CCD, ARG_CCD, SFR_OCAL, SFR_OARG,   & 
     125                  N_PROD, N_CONS, C_PROD, C_CONS, O2_PROD, O2_CONS, O2_ANOX, RR_0100, RR_0500,       & 
     126                  RR_1000, IBEN_N, IBEN_FE, IBEN_C, IBEN_SI, IBEN_CA, OBEN_N, OBEN_FE, OBEN_C,       & 
     127                  OBEN_SI, OBEN_CA, BEN_N, BEN_FE, BEN_C, BEN_SI, BEN_CA, RUNOFF, RIV_N, RIV_SI,     & 
     128                  RIV_C, RIV_ALK, DETC, SDC__100, SDC__200, SDC__500, SDC_1000, INVTC, INVTALK,      & 
     129                  INVTO2, LYSO_CA, COM_RESP, PN_LLOSS, PD_LLOSS, ZI_LLOSS, ZE_LLOSS, ZI_MES_N,       & 
     130                  ZI_MES_D, ZI_MES_C, ZI_MESDC, ZI_EXCR, ZI_RESP, ZI_GROW, ZE_MES_N, ZE_MES_D,       & 
     131                  ZE_MES_C, ZE_MESDC, ZE_EXCR, ZE_RESP, ZE_GROW, MDETC, GMIDC, GMEDC,                & 
     132                  INT_ZMI, INT_ZME, INT_DET, INT_DTC, DMS_SURF, DMS_ANDR, DMS_SIMO, DMS_ARAN,        & 
     133                  DMS_HALL, DMS_ANDM, ATM_XCO2, OCN_FCO2, ATM_FCO2, OCN_RHOSW, OCN_SCHCO2,           & 
     134                  OCN_KWCO2, OCN_K0, CO2STARAIR, OCN_DPCO2,                                          & ! end of regular 2D 
     135                  TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3,                                             & ! end of regular 3D 
     136! AXY (11/11/16): additional CMIP6 2D diagnostics 
     137                  epC100, epCALC100, epN100, epSI100,                                                & 
     138                  FGCO2, INTDISSIC, INTDISSIN, INTDISSISI, INTTALK, O2min, ZO2min,                   & 
     139                  FBDDTALK, FBDDTDIC, FBDDTDIFE, FBDDTDIN, FBDDTDISI,                                &  
     140! AXY (11/11/16): additional CMIP6 3D diagnostics 
     141                  TPPD3,                                                                             & 
     142                  BDDTALK3, BDDTDIC3, BDDTDIFE3, BDDTDIN3, BDDTDISI3,                                &  
     143                  FD_NIT3, FD_SIL3, FD_CAR3, FD_CAL3,                                                &  
     144                  CO33, CO3SATARAG3, CO3SATCALC3, DCALC3,                                            & 
     145                  EXPC3, EXPN3, EXPCALC3, EXPSI3,                                                    & 
     146                  FEDISS3, FESCAV3,                                                                  & 
     147                  MIGRAZP3, MIGRAZD3, MEGRAZP3, MEGRAZD3, MEGRAZZ3,                                  & 
     148                  O2SAT3, PBSI3, PCAL3, REMOC3,                                                      & 
     149                  PNLIMJ3, PNLIMN3, PNLIMFE3, PDLIMJ3, PDLIMN3, PDLIMFE3, PDLIMSI3        
     150                  !! 
     151                  !! list of all MEDUSA diagnostics that could be called by iom_use 
     152   END TYPE DIAG_IOM   
     153   !! 
     154   TYPE(DIAG_IOM), PUBLIC :: med_diag  ! define which diagnostics are asked in outputs 
     155# endif                    
     156 
    106157   !! information for inputs 
    107158   !! -------------------------------------------------- 
     
    216267 
    217268      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 
     269 
     270      ! It is known that not intialising SBC_TRC can introduce NaNs 
     271      sbc_trc(:,:,:) = 0.0 
     272 
    218273      ! 
    219274   END FUNCTION trc_alloc 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r7203 r8155  
    88   !!            2.0  ! 2005-10 (C. Ethe, G. Madec) revised architecture 
    99   !!            4.0  ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 
     10   !!             -   ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 
    1011   !!---------------------------------------------------------------------- 
    1112#if defined key_top 
     
    2425   USE trcini_c14b     ! C14 bomb initialisation 
    2526   USE trcini_my_trc   ! MY_TRC   initialisation 
     27   USE trcini_medusa   ! MEDUSA   initialisation 
     28   USE trcini_idtra    ! idealize tracer initialisation 
     29   USE trcini_age      ! AGE      initialisation 
    2630   USE trcdta          ! initialisation from files 
    2731   USE daymod          ! calendar manager 
     
    7680         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 
    7781         & Computation of a daily mean shortwave for some biogeochemical models) ') 
    78  
     82          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     83          !!!!! CHECK For MEDUSA 
     84          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    7985      IF( nn_cla == 1 )   & 
    8086         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
     
    97103 
    98104      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 
    99107      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    100108      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
     109      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer 
    101110      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
    102111 
    103112      CALL trc_ice_ini                                 ! Tracers in sea ice 
    104113 
    105       IF( lwp ) THEN 
     114# if defined key_debug_medusa 
     115         IF (lwp) write (numout,*) '------------------------------' 
     116         IF (lwp) write (numout,*) 'Jpalm - debug' 
     117         IF (lwp) write (numout,*) ' in trc_init' 
     118         IF (lwp) write (numout,*) ' sms init OK' 
     119         IF (lwp) write (numout,*) ' next: open tracer.stat' 
     120         IF (lwp) write (numout,*) ' ' 
     121         CALL flush(numout) 
     122# endif 
     123 
     124      IF( ln_ctl ) THEN 
    106125         ! 
    107          CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
     126         IF (narea == 1) THEN   
     127            ! The tracer.stat file only contains global tracer sum values, if  
     128            ! it contains anything at all. Hence it only needs to be opened  
     129            ! and written to on the master PE, not on all PEs.   
     130            CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE','FORMATTED',  &  
     131                          'SEQUENTIAL', -1, numout, lwp , narea )  
     132         ENDIF   
    108133         ! 
    109134      ENDIF 
    110135 
    111       IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    112  
     136# if defined key_debug_medusa 
     137         IF (lwp) write (numout,*) '------------------------------' 
     138         IF (lwp) write (numout,*) 'Jpalm - debug' 
     139         IF (lwp) write (numout,*) ' in trc_init' 
     140         IF (lwp) write (numout,*) 'open tracer.stat -- OK' 
     141         IF (lwp) write (numout,*) ' ' 
     142         CALL flush(numout) 
     143# endif 
     144 
     145 
     146      IF( ln_trcdta ) THEN 
     147#if defined key_medusa 
     148         IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 
     149         IF(lwp) CALL flush(numout) 
     150#endif 
     151         CALL trc_dta_init(jptra) 
     152      ENDIF 
    113153 
    114154      IF( ln_rsttr ) THEN 
    115155        ! 
     156#if defined key_medusa 
     157        IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 
     158        IF(lwp) CALL flush(numout) 
     159#endif 
    116160        CALL trc_rst_read              ! restart from a file 
    117161        ! 
    118162      ELSE 
     163        ! 
     164# if defined key_debug_medusa 
     165         IF (lwp) write (numout,*) '------------------------------' 
     166         IF (lwp) write (numout,*) 'Jpalm - debug' 
     167         IF (lwp) write (numout,*) ' Init from file -- will call trc_dta' 
     168         IF (lwp) write (numout,*) ' ' 
     169         CALL flush(numout) 
     170# endif 
    119171        ! 
    120172        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
     
    137189        ENDIF 
    138190        ! 
     191# if defined key_debug_medusa 
     192         IF (lwp) write (numout,*) '------------------------------' 
     193         IF (lwp) write (numout,*) 'Jpalm - debug' 
     194         IF (lwp) write (numout,*) ' in trc_init' 
     195         IF (lwp) write (numout,*) ' before trb = trn' 
     196         IF (lwp) write (numout,*) ' ' 
     197         CALL flush(numout) 
     198# endif 
     199        ! 
    139200        trb(:,:,:,:) = trn(:,:,:,:) 
     201        !  
     202# if defined key_debug_medusa 
     203         IF (lwp) write (numout,*) '------------------------------' 
     204         IF (lwp) write (numout,*) 'Jpalm - debug' 
     205         IF (lwp) write (numout,*) ' in trc_init' 
     206         IF (lwp) write (numout,*) ' trb = trn -- OK' 
     207         IF (lwp) write (numout,*) ' ' 
     208         CALL flush(numout) 
     209# endif 
    140210        !  
    141211      ENDIF 
     
    146216      IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   & 
    147217        &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level 
    148  
    149  
     218      ! 
     219# if defined key_debug_medusa 
     220         IF (lwp) write (numout,*) '------------------------------' 
     221         IF (lwp) write (numout,*) 'Jpalm - debug' 
     222         IF (lwp) write (numout,*) ' in trc_init' 
     223         IF (lwp) write (numout,*) ' partial step -- OK' 
     224         IF (lwp) write (numout,*) ' ' 
     225         CALL flush(numout) 
     226# endif 
    150227      ! 
    151228      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    152229      ! 
    153  
     230# if defined key_debug_medusa 
     231         IF (lwp) write (numout,*) '------------------------------' 
     232         IF (lwp) write (numout,*) 'Jpalm - debug' 
     233         IF (lwp) write (numout,*) ' in trc_init' 
     234         IF (lwp) write (numout,*) ' before initiate tracer contents' 
     235         IF (lwp) write (numout,*) ' ' 
     236         CALL flush(numout) 
     237# endif 
     238      ! 
    154239      trai(:) = 0._wp                                                   ! initial content of all tracers 
    155240      DO jn = 1, jptra 
     
    164249         WRITE(numout,*) '          *** Total inital content of all tracers ' 
    165250         WRITE(numout,*) 
     251# if defined key_debug_medusa 
     252         CALL flush(numout) 
     253# endif 
     254         ! 
     255# if defined key_debug_medusa 
     256         WRITE(numout,*) ' litle check :  ', ctrcnm(1) 
     257         CALL flush(numout) 
     258# endif 
    166259         DO jn = 1, jptra 
    167260            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
     
    176269         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    177270      ENDIF 
     271 
     272      IF(lwp) WRITE(numout,*) 
     273      IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 
     274      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     275      IF(lwp) CALL flush(numout) 
     276# if defined key_debug_medusa 
     277         CALL trc_rst_stat 
     278         CALL flush(numout) 
     279# endif 
     280 
    1782819000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    179282      ! 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r7203 r8155  
    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 
     
    2526   USE trcnam_c14b       ! C14 SMS namelist 
    2627   USE trcnam_my_trc     ! MY_TRC SMS namelist 
     28   USE trcnam_medusa     ! MEDUSA namelist 
     29   USE trcnam_idtra      ! Idealise tracer namelist 
     30   USE trcnam_age        ! AGE SMS namelist 
    2731   USE trd_oce        
    2832   USE trdtrc_oce 
     
    5458      !! ** Method  : - read passive tracer namelist  
    5559      !!              - read namelist of each defined SMS model 
    56       !!                ( (PISCES, CFC, MY_TRC ) 
    57       !!--------------------------------------------------------------------- 
    58       INTEGER  ::   jn                  ! dummy loop indice 
     60      !!                ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA, Age ) 
     61      !!--------------------------------------------------------------------- 
     62      INTEGER  ::   jn, jk                     ! dummy loop indice 
    5963      !                                        !   Parameters of the run  
    6064      IF( .NOT. lk_offline ) CALL trc_nam_run 
    6165       
    6266      !                                        !  passive tracer informations 
     67# if defined key_debug_medusa 
     68      CALL flush(numout) 
     69      IF (lwp) write (numout,*) '------------------------------' 
     70      IF (lwp) write (numout,*) 'Jpalm - debug' 
     71      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc' 
     72      IF (lwp) write (numout,*) ' ' 
     73# endif 
     74      ! 
    6375      CALL trc_nam_trc 
    6476       
    6577      !                                        !   Parameters of additional diagnostics 
     78# if defined key_debug_medusa 
     79      CALL flush(numout) 
     80      IF (lwp) write (numout,*) '------------------------------' 
     81      IF (lwp) write (numout,*) 'Jpalm - debug' 
     82      IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK' 
     83      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia' 
     84      IF (lwp) write (numout,*) ' ' 
     85# endif 
     86      ! 
     87 
    6688      CALL trc_nam_dia 
    6789 
    6890      !                                        !   namelist of transport 
     91# if defined key_debug_medusa 
     92      CALL flush(numout) 
     93      IF (lwp) write (numout,*) '------------------------------' 
     94      IF (lwp) write (numout,*) 'Jpalm - debug' 
     95      IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK' 
     96      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp' 
     97      IF (lwp) write (numout,*) ' ' 
     98# endif 
     99      ! 
    69100      CALL trc_nam_trp 
     101      ! 
     102# if defined key_debug_medusa 
     103      CALL flush(numout) 
     104      IF (lwp) write (numout,*) '------------------------------' 
     105      IF (lwp) write (numout,*) 'Jpalm - debug' 
     106      IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK' 
     107      IF (lwp) write (numout,*) 'continue trc_nam ' 
     108      IF (lwp) write (numout,*) ' ' 
     109      CALL flush(numout) 
     110# endif 
     111      ! 
    70112 
    71113 
     
    89131         END DO 
    90132         WRITE(numout,*) ' ' 
     133# if defined key_debug_medusa 
     134      CALL flush(numout) 
     135# endif 
    91136      ENDIF 
    92137 
     
    107152            WRITE(numout,*) 
    108153         ENDIF 
    109       ENDIF 
    110  
     154# if defined key_debug_medusa 
     155      CALL flush(numout) 
     156# endif 
     157      ENDIF 
     158 
     159# if defined key_debug_medusa 
     160       DO jk = 1, jpk 
     161          WRITE(numout,*) '  level number: ', jk, 'rdttrc: ',rdttrc(jk),'rdttra: ', rdttra(jk),'nn_dttrc: ', nn_dttrc 
     162       END DO 
     163      CALL flush(numout) 
     164# endif 
    111165       
    112166      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step 
     
    116170        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
    117171        WRITE(numout,*)  
     172# if defined key_debug_medusa 
     173      CALL flush(numout) 
     174# endif 
    118175      ENDIF 
    119176 
     
    143200               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
    144201            END DO 
     202         WRITE(numout,*) ' ' 
     203         CALL flush(numout) 
    145204         ENDIF 
    146205#endif 
    147206 
     207# if defined key_debug_medusa 
     208      CALL flush(numout) 
     209      IF (lwp) write (numout,*) '------------------------------' 
     210      IF (lwp) write (numout,*) 'Jpalm - debug' 
     211      IF (lwp) write (numout,*) 'just before ice module for tracers call : ' 
     212      IF (lwp) write (numout,*) ' ' 
     213# endif 
     214      ! 
    148215 
    149216      ! Call the ice module for tracers 
    150217      ! ------------------------------- 
    151218      CALL trc_nam_ice 
     219 
     220# if defined key_debug_medusa 
     221      CALL flush(numout) 
     222      IF (lwp) write (numout,*) '------------------------------' 
     223      IF (lwp) write (numout,*) 'Jpalm - debug' 
     224      IF (lwp) write (numout,*) 'Will now read SMS namelists : ' 
     225      IF (lwp) write (numout,*) ' ' 
     226# endif 
     227      ! 
    152228 
    153229      ! namelist of SMS 
     
    156232      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used' 
    157233      ENDIF 
    158  
     234      ! 
     235# if defined key_debug_medusa 
     236      CALL flush(numout) 
     237      IF (lwp) write (numout,*) '------------------------------' 
     238      IF (lwp) write (numout,*) 'Jpalm - debug' 
     239      IF (lwp) write (numout,*) 'CALL trc_nam_pisces  -- OK' 
     240      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 
     241      IF (lwp) write (numout,*) ' ' 
     242# endif 
     243      ! 
     244      IF( lk_medusa  ) THEN   ;   CALL trc_nam_medusa      ! MEDUSA  tracers 
     245      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MEDUSA not used' 
     246      ENDIF 
     247      ! 
     248# if defined key_debug_medusa 
     249      CALL flush(numout) 
     250      IF (lwp) write (numout,*) '------------------------------' 
     251      IF (lwp) write (numout,*) 'Jpalm - debug' 
     252      IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK' 
     253      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra' 
     254      IF (lwp) write (numout,*) ' ' 
     255# endif 
     256      ! 
     257      IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers 
     258      ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used' 
     259      ENDIF 
     260      ! 
     261# if defined key_debug_medusa 
     262      CALL flush(numout) 
     263      IF (lwp) write (numout,*) '------------------------------' 
     264      IF (lwp) write (numout,*) 'Jpalm - debug' 
     265      IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK' 
     266      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc' 
     267      IF (lwp) write (numout,*) ' ' 
     268# endif 
     269      ! 
    159270      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers 
    160271      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    161272      ENDIF 
    162  
     273      ! 
     274# if defined key_debug_medusa 
     275      CALL flush(numout) 
     276      IF (lwp) write (numout,*) '------------------------------' 
     277      IF (lwp) write (numout,*) 'Jpalm - debug' 
     278      IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 
     279      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14' 
     280      IF (lwp) write (numout,*) ' ' 
     281# endif 
     282      ! 
    163283      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    164284      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    165285      ENDIF 
    166  
     286      ! 
     287# if defined key_debug_medusa 
     288      CALL flush(numout) 
     289      IF (lwp) write (numout,*) '------------------------------' 
     290      IF (lwp) write (numout,*) 'Jpalm - debug' 
     291      IF (lwp) write (numout,*) 'CALL trc_nam_c14 -- OK' 
     292      IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_age' 
     293      IF (lwp) write (numout,*) ' ' 
     294# endif 
     295      ! 
     296      IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer 
     297      ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used' 
     298      ENDIF 
     299      ! 
     300# if defined key_debug_medusa 
     301      CALL flush(numout) 
     302      IF (lwp) write (numout,*) '------------------------------' 
     303      IF (lwp) write (numout,*) 'Jpalm - debug' 
     304      IF (lwp) write (numout,*) 'CALL trc_nam_age -- OK' 
     305      IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam -- OK' 
     306      IF (lwp) write (numout,*) ' ' 
     307# endif 
     308      ! 
    167309      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
    168310      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    169311      ENDIF 
    170       ! 
     312        
     313      IF(lwp)   CALL flush(numout) 
    171314   END SUBROUTINE trc_nam 
    172315 
     
    216359         WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler 
    217360         WRITE(numout,*) ' ' 
     361        CALL flush(numout) 
    218362      ENDIF 
    219363      ! 
     
    306450         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    307451      END DO 
    308        
     452      IF(lwp)  CALL flush(numout)       
     453 
    309454    END SUBROUTINE trc_nam_trc 
    310455 
     
    357502         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio 
    358503         WRITE(numout,*) ' ' 
    359       ENDIF 
    360  
    361       IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
     504         CALL flush(numout) 
     505      ENDIF 
     506!! 
     507!! JPALM -- 17-07-2015 -- 
     508!! MEDUSA is not yet up-to-date with the iom server. 
     509!! we use it for the main tracer, but not fully with diagnostics. 
     510!! will have to adapt it properly when visiting Christian Ethee 
     511!! for now, we change  
     512!! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 
     513!! to : 
     514!! 
     515      IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN  
    362516         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
    363517           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
     
    368522         trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' '  
    369523         ! 
     524      !! ELSE IF  ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN 
     525      !!    CALL trc_nam_iom_medusa 
    370526      ENDIF 
    371527 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r7203 r8155  
    2727   USE trcnam_trp 
    2828   USE iom 
     29   USE ioipsl, ONLY : ju2ymds    ! for calendar 
    2930   USE daymod 
     31   !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 
     32   USE sms_medusa 
     33   USE trcsms_medusa 
     34   !! 
     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   USE sbc_oce, ONLY: lk_oasis  
     44   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable 
     45 
    3046   IMPLICIT NONE 
    3147   PRIVATE 
     
    3551   PUBLIC   trc_rst_wri       ! called by ??? 
    3652   PUBLIC   trc_rst_cal 
     53   PUBLIC   trc_rst_stat 
     54   PUBLIC   trc_rst_dia_stat 
     55   PUBLIC   trc_rst_tra_stat 
    3756 
    3857   !! * Substitutions 
     
    4867      !!---------------------------------------------------------------------- 
    4968      INTEGER, INTENT(in) ::   kt       ! number of iteration 
     69      INTEGER             ::   iyear, imonth, iday 
     70      REAL (wp)           ::   zsec 
     71      REAL (wp)           ::   zfjulday 
    5072      ! 
    5173      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
     
    78100      ! 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 
    79101      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
    80          ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    81          IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    82          ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
     102         IF ( ln_rstdate ) THEN 
     103            !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name 
     104            !!                     -- the condition to open the rst file is not the same than for the dynamic rst. 
     105            !!                     -- here it - for an obscure reason - is open 2 time-step before the restart writing process 
     106            !!                     instead of 1. 
     107            !!                     -- i am not sure if someone forgot +1 in the if loop condition as 
     108            !!                     it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is  
     109            !!                     nitrst - 2*nn_dttrc 
     110            !!                     -- nevertheless we didn't wanted to broke something already working  
     111            !!                     and just adapted the part we added. 
     112            !!                     -- So instead of calling ju2ymds( fjulday + (rdttra(1))  
     113            !!                     we call ju2ymds( fjulday + (2*rdttra(1))  
     114            !!--------------------------------------------------------------------       
     115            zfjulday = fjulday + (2*rdttra(1)) / rday 
     116            IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error 
     117            CALL ju2ymds( zfjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec ) 
     118            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 
     119         ELSE 
     120            ! beware of the format used to write kt (default is i8.8, that should be large enough) 
     121            IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
     122            ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
     123            ENDIF 
    83124         ENDIF 
    84125         ! create the file 
     
    101142      !! ** purpose  :   read passive tracer fields in restart files 
    102143      !!---------------------------------------------------------------------- 
    103       INTEGER  ::  jn      
     144      INTEGER  ::  jn, jl      
     145      !! AXY (05/11/13): temporary variables 
     146      REAL(wp) ::    fq0,fq1,fq2 
    104147 
    105148      !!---------------------------------------------------------------------- 
     
    112155      DO jn = 1, jptra 
    113156         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
     157         trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:) 
    114158      END DO 
    115159 
    116160      DO jn = 1, jptra 
    117161         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    118       END DO 
     162         trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:) 
     163      END DO 
     164      ! 
     165      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 
     166      !!                 call to MEDUSA-2 at this point; this suggests that the FCM 
     167      !!                 version of NEMO date significantly earlier than the current 
     168      !!                 version 
     169 
     170#if defined key_medusa 
     171      !! AXY (13/01/12): check if the restart contains sediment fields; 
     172      !!                 this is only relevant for simulations that include 
     173      !!                 biogeochemistry and are restarted from earlier runs 
     174      !!                 in which there was no sediment component 
     175      !! 
     176      IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN 
     177         !! YES; in which case read them 
     178         !! 
     179         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...' 
     180         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N',  zb_sed_n(:,:)  ) 
     181         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N',  zn_sed_n(:,:)  ) 
     182         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) ) 
     183         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) ) 
     184         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) ) 
     185         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) ) 
     186         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C',  zb_sed_c(:,:)  ) 
     187         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C',  zn_sed_c(:,:)  ) 
     188         CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) ) 
     189         CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) ) 
     190      ELSE 
     191         !! NO; in which case set them to zero 
     192         !! 
     193         IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...' 
     194         zb_sed_n(:,:)  = 0.0   !! organic N 
     195         zn_sed_n(:,:)  = 0.0 
     196         zb_sed_fe(:,:) = 0.0   !! organic Fe 
     197         zn_sed_fe(:,:) = 0.0 
     198         zb_sed_si(:,:) = 0.0   !! inorganic Si 
     199         zn_sed_si(:,:) = 0.0 
     200         zb_sed_c(:,:)  = 0.0   !! organic C 
     201         zn_sed_c(:,:)  = 0.0 
     202         zb_sed_ca(:,:) = 0.0   !! inorganic C 
     203         zn_sed_ca(:,:) = 0.0 
     204      ENDIF 
     205      !! 
     206      !! calculate stats on these fields 
     207      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
     208      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N') 
     209      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 
     210      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 
     211      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 
     212      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 
     213      !! 
     214      !! AXY (07/07/15): read in temporally averaged fields for DMS 
     215      !!                 calculations 
     216      !! 
     217      IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN 
     218         !! YES; in which case read them 
     219         !! 
     220         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...' 
     221         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN',  zb_dms_chn(:,:)  ) 
     222         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN',  zn_dms_chn(:,:)  ) 
     223         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD',  zb_dms_chd(:,:)  ) 
     224         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD',  zn_dms_chd(:,:)  ) 
     225         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD',  zb_dms_mld(:,:)  ) 
     226         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD',  zn_dms_mld(:,:)  ) 
     227         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR',  zb_dms_qsr(:,:)  ) 
     228         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR',  zn_dms_qsr(:,:)  ) 
     229         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN',  zb_dms_din(:,:)  ) 
     230         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN',  zn_dms_din(:,:)  ) 
     231      ELSE 
     232         !! NO; in which case set them to zero 
     233         !! 
     234         IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...' 
     235         zb_dms_chn(:,:)  = 0.0   !! CHN 
     236         zn_dms_chn(:,:)  = 0.0 
     237         zb_dms_chd(:,:)  = 0.0   !! CHD 
     238         zn_dms_chd(:,:)  = 0.0 
     239         zb_dms_mld(:,:)  = 0.0   !! MLD 
     240         zn_dms_mld(:,:)  = 0.0 
     241         zb_dms_qsr(:,:)  = 0.0   !! QSR 
     242         zn_dms_qsr(:,:)  = 0.0 
     243         zb_dms_din(:,:)  = 0.0   !! DIN 
     244         zn_dms_din(:,:)  = 0.0 
     245      ENDIF 
     246      !!   
     247      !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 
     248      !!                  -- needed for the coupling with atm 
     249      IF( iom_varid( numrtr, 'N_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN 
     250         IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...' 
     251         CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf',  zb_dms_srf(:,:)  ) 
     252         CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf',  zn_dms_srf(:,:)  ) 
     253      ELSE 
     254         IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...' 
     255         zb_dms_srf(:,:)  = 0.0   !! DMS 
     256         zn_dms_srf(:,:)  = 0.0 
     257      ENDIF 
     258      IF (lk_oasis) THEN 
     259         DMS_out_cpl(:,:) = zn_dms_srf(:,:)        !! Coupling variable 
     260      END IF 
     261      !! 
     262      IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN 
     263         IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...' 
     264         CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx',  zb_co2_flx(:,:)  ) 
     265         CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx',  zn_co2_flx(:,:)  ) 
     266      ELSE 
     267         IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...' 
     268         zb_co2_flx(:,:)  = 0.0   !! CO2 flx 
     269         zn_co2_flx(:,:)  = 0.0 
     270      ENDIF 
     271      IF (lk_oasis) THEN 
     272         CO2Flux_out_cpl(:,:) =  zn_co2_flx(:,:)   !! Coupling variable 
     273      END IF 
     274      !! 
     275      !! JPALM 02-06-2017 -- in complement to DMS surf  
     276      !!                  -- the atm model needs surf Chl  
     277      !!                     as proxy of org matter from the ocean 
     278      !!                  -- needed for the coupling with atm 
     279      IF( iom_varid( numrtr, 'N_CHL_srf', ldstop = .FALSE. ) > 0 ) THEN 
     280         IF(lwp) WRITE(numout,*) 'Chl surf concentration - reading in ...' 
     281         CALL iom_get( numrtr, jpdom_autoglo, 'N_CHL_srf',  zn_chl_srf(:,:)  ) 
     282      ELSE 
     283         IF(lwp) WRITE(numout,*) 'Chl surf concentration - setting to zero ...' 
     284         zn_chl_srf(:,:)  = (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6 
     285      ENDIF 
     286      IF (lk_oasis) THEN 
     287         chloro_out_cpl(:,:) = zn_chl_srf(:,:)        !! Coupling variable 
     288      END IF 
     289      !! 
     290      !! calculate stats on these fields 
     291      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 
     292      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 
     293      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 
     294      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 
     295      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 
     296      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 
     297      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 
     298      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 
     299      call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 
     300      !!   
     301      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 
     302      !!                  -- needed for monthly call of carb-chem routine and better reproducibility 
     303# if defined key_roam 
     304      IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN 
     305         IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...' 
     306         CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D'   ,  f3_pH(:,:,:)     ) 
     307         CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D',  f3_h2co3(:,:,:)  ) 
     308         CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' ,  f3_hco3(:,:,:)   ) 
     309         CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D'  ,  f3_co3(:,:,:)    ) 
     310         CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D',  f3_omcal(:,:,:)  ) 
     311         CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D',  f3_omarg(:,:,:)  ) 
     312         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' ,  f2_ccd_cal(:,:)  ) 
     313         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' ,  f2_ccd_arg(:,:)  ) 
     314         !! 
     315         IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 
     316      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf') 
     317      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 
     318      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 
     319      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' ) 
     320      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 
     321      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 
     322      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 
     323      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 
     324 
     325      ELSE 
     326         IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... ' 
     327         IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not ' 
     328         IF(lwp) WRITE(numout,*) 'Check if   mod(kt*rdt,2592000) == rdt'  
     329         IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...'  
     330      ENDIF 
     331# endif 
     332 
     333 
     334#endif 
     335      ! 
     336#if defined key_idtra 
     337      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and  
     338      !!                        writting here undre their key. 
     339      !!                        problems in CFC restart, maybe because of this... 
     340      !!                        and pb in idtra diag or diad-restart writing. 
     341      !!---------------------------------------------------------------------- 
     342      IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN 
     343         !! YES; in which case read them 
     344         !! 
     345         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...' 
     346         CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA',  qint_idtra(:,:,1)  ) 
     347      ELSE 
     348         !! NO; in which case set them to zero 
     349         !! 
     350         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...' 
     351         qint_idtra(:,:,1)  = 0.0   !! CHN 
     352      ENDIF 
     353      !! 
     354      !! calculate stats on these fields 
     355      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 
     356      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 
     357#endif 
     358      ! 
     359#if defined key_cfc 
     360      DO jl = 1, jp_cfc 
     361         jn = jp_cfc0 + jl - 1 
     362         IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN 
     363            !! YES; in which case read them 
     364            !! 
     365            IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...' 
     366            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
     367         ELSE 
     368            !! NO; in which case set them to zero 
     369            !! 
     370            IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...' 
     371            qint_cfc(:,:,jn)  = 0.0   !! CHN 
     372         ENDIF 
     373         !! 
     374         !! calculate stats on these fields 
     375         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 
     376         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 
     377      END DO 
     378#endif 
    119379      ! 
    120380   END SUBROUTINE trc_rst_read 
     
    128388      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    129389      !! 
    130       INTEGER  :: jn 
     390      INTEGER  :: jn, jl 
    131391      REAL(wp) :: zarak0 
     392      !! AXY (05/11/13): temporary variables 
     393      REAL(wp) ::    fq0,fq1,fq2 
    132394      !!---------------------------------------------------------------------- 
    133395      ! 
     
    142404         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    143405      END DO 
    144       ! 
     406 
     407      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 
     408      !!                 call to MEDUSA-2 at this point; this suggests that the FCM 
     409      !!                 version of NEMO date significantly earlier than the current 
     410      !!                 version 
     411 
     412#if defined key_medusa 
     413      !! AXY (13/01/12): write out "before" and "now" state of seafloor 
     414      !!                 sediment pools into restart; this happens 
     415      !!                 whether or not the pools are to be used by 
     416      !!                 MEDUSA (which is controlled by a switch in the 
     417      !!                 namelist_top file) 
     418      !! 
     419      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' 
     420      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N',  zb_sed_n(:,:)  ) 
     421      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N',  zn_sed_n(:,:)  ) 
     422      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) ) 
     423      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) ) 
     424      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) ) 
     425      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) ) 
     426      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C',  zb_sed_c(:,:)  ) 
     427      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C',  zn_sed_c(:,:)  ) 
     428      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) ) 
     429      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) ) 
     430      !! 
     431      !! calculate stats on these fields 
     432      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
     433      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N') 
     434      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 
     435      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 
     436      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 
     437      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 
     438      !! 
     439      !! AXY (07/07/15): write out temporally averaged fields for DMS 
     440      !!                 calculations 
     441      !! 
     442      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...' 
     443      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN',  zb_dms_chn(:,:)  ) 
     444      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN',  zn_dms_chn(:,:)  ) 
     445      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD',  zb_dms_chd(:,:)  ) 
     446      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD',  zn_dms_chd(:,:)  ) 
     447      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD',  zb_dms_mld(:,:)  ) 
     448      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD',  zn_dms_mld(:,:)  ) 
     449      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR',  zb_dms_qsr(:,:)  ) 
     450      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR',  zn_dms_qsr(:,:)  ) 
     451      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN',  zb_dms_din(:,:)  ) 
     452      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN',  zn_dms_din(:,:)  ) 
     453         !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 
     454         !!                  -- needed for the coupling with atm 
     455      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf',  zb_dms_srf(:,:)  ) 
     456      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf',  zn_dms_srf(:,:)  ) 
     457      CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx',  zb_co2_flx(:,:)  ) 
     458      CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx',  zn_co2_flx(:,:)  ) 
     459      CALL iom_rstput( kt, nitrst, numrtw, 'N_CHL_srf',  zn_chl_srf(:,:)  ) 
     460      !! 
     461      !! calculate stats on these fields 
     462      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 
     463      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 
     464      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 
     465      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 
     466      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 
     467      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 
     468      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 
     469      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 
     470      call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 
     471      !! 
     472      IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.' 
     473      call trc_rst_dia_stat(dust(:,:), 'Dust dep') 
     474      call trc_rst_dia_stat(zirondep(:,:), 'Iron dep') 
     475      !!  
     476      !!   
     477      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 
     478      !!                  -- needed for monthly call of carb-chem routine and better reproducibility 
     479# if defined key_roam 
     480      IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...' 
     481      CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D'   ,  f3_pH(:,:,:)     ) 
     482      CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D',  f3_h2co3(:,:,:)  ) 
     483      CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' ,  f3_hco3(:,:,:)   ) 
     484      CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D'  ,  f3_co3(:,:,:)    ) 
     485      CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D',  f3_omcal(:,:,:)  ) 
     486      CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D',  f3_omarg(:,:,:)  ) 
     487      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' ,  f2_ccd_cal(:,:)  ) 
     488      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' ,  f2_ccd_arg(:,:)  ) 
     489      !! 
     490      IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 
     491      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf') 
     492      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 
     493      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 
     494      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' ) 
     495      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 
     496      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 
     497      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 
     498      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 
     499      !! 
     500# endif 
     501!! 
     502#endif 
     503      ! 
     504#if defined key_idtra 
     505      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and  
     506      !!                        writting here undre their key. 
     507      !!                        problems in CFC restart, maybe because of this... 
     508      !!                        and pb in idtra diag or diad-restart writing. 
     509      !!---------------------------------------------------------------------- 
     510      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...' 
     511      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA',  qint_idtra(:,:,1) ) 
     512      !! 
     513      !! calculate stats on these fields 
     514      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 
     515      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 
     516#endif 
     517      ! 
     518#if defined key_cfc 
     519      DO jl = 1, jp_cfc 
     520         jn = jp_cfc0 + jl - 1 
     521         IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...' 
     522         CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
     523         !! 
     524         !! calculate stats on these fields 
     525         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 
     526         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 
     527      END DO 
     528#endif 
     529      ! 
     530 
    145531      IF( kt == nitrst ) THEN 
    146532          CALL trc_rst_stat            ! statistics 
     
    304690         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 
    305691      END DO 
    306       WRITE(numout,*)  
     692      IF(lwp) WRITE(numout,*)  
    3076939000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
    308694      &      '    max :',e18.10,'    drift :',e18.10, ' %') 
    309695      ! 
    310696   END SUBROUTINE trc_rst_stat 
     697 
     698 
     699   SUBROUTINE trc_rst_tra_stat 
     700      !!---------------------------------------------------------------------- 
     701      !!                    ***  trc_rst_tra_stat  *** 
     702      !! 
     703      !! ** purpose  :   Compute tracers statistics - check where crazy values appears 
     704      !!---------------------------------------------------------------------- 
     705      INTEGER  :: jk, jn 
     706      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf 
     707      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     708      !!---------------------------------------------------------------------- 
     709 
     710      IF( lwp ) THEN 
     711         WRITE(numout,*) 
     712         WRITE(numout,*) '           ----SURFACE TRA STAT----             ' 
     713         WRITE(numout,*) 
     714      ENDIF 
     715      ! 
     716      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
     717      areasf = glob_sum(zvol(:,:)) 
     718      DO jn = 1, jptra 
     719         ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 
     720         zmin  = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
     721         zmax  = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
     722         IF( lk_mpp ) THEN 
     723            CALL mpp_min( zmin )      ! min over the global domain 
     724            CALL mpp_max( zmax )      ! max over the global domain 
     725         END IF 
     726         zmean  = ztraf / areasf 
     727         IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 
     728      END DO 
     729      IF(lwp) WRITE(numout,*) 
     7309001  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     731      &      '    max :',e18.10) 
     732      ! 
     733   END SUBROUTINE trc_rst_tra_stat 
     734 
     735 
     736 
     737   SUBROUTINE trc_rst_dia_stat( dgtr, names) 
     738      !!---------------------------------------------------------------------- 
     739      !!                    ***  trc_rst_dia_stat  *** 
     740      !! 
     741      !! ** purpose  :   Compute tracers statistics 
     742      !!---------------------------------------------------------------------- 
     743      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var 
     744      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name 
     745      !!--------------------------------------------------------------------- 
     746      INTEGER  :: jk, jn 
     747      REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 
     748      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     749      !!---------------------------------------------------------------------- 
     750 
     751      IF( lwp )  WRITE(numout,*) 'STAT- ', names 
     752      ! 
     753      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
     754      ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 
     755      !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 
     756      areasf = glob_sum(zvol(:,:)) 
     757      zmin  = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
     758      zmax  = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
     759      IF( lk_mpp ) THEN 
     760         CALL mpp_min( zmin )      ! min over the global domain 
     761         CALL mpp_max( zmax )      ! max over the global domain 
     762      END IF 
     763      zmean  = ztraf / areasf 
     764      IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 
     765      ! 
     766      IF(lwp) WRITE(numout,*) 
     7679002  FORMAT(' tracer name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     768      &      '    max :',e18.10 ) 
     769      ! 
     770   END SUBROUTINE trc_rst_dia_stat 
     771 
    311772 
    312773#else 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r7203 r8155  
    1616   USE trc                ! 
    1717   USE trcsms_pisces      ! PISCES biogeo-model 
     18   USE trcsms_medusa      ! MEDUSA tracers 
     19   USE trcsms_idtra       ! Idealize Tracer 
    1820   USE trcsms_cfc         ! CFC 11 & 12 
    1921   USE trcsms_c14b        ! C14b tracer  
     22   USE trcsms_age         ! AGE tracer  
    2023   USE trcsms_my_trc      ! MY_TRC  tracers 
    2124   USE prtctl_trc         ! Print control for debbuging 
     
    4346      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    4447      !! 
     48      INTEGER            ::  jn 
    4549      CHARACTER (len=25) :: charout 
    4650      !!--------------------------------------------------------------------- 
     
    4953      ! 
    5054      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
     55      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers 
     56# if defined key_debug_medusa 
     57         IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK --  next IDTRA -- ' 
     58      CALL flush(numout) 
     59# endif 
     60      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer 
     61# if defined key_debug_medusa 
     62         IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK --  next CFC -- ' 
     63      CALL flush(numout) 
     64# endif 
    5165      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
     66# if defined key_debug_medusa 
     67         IF(lwp) WRITE(numout,*) '--trcsms : CFC OK --  next C14 -- ' 
     68      CALL flush(numout) 
     69# endif 
    5270      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
     71# if defined key_debug_medusa 
     72         IF(lwp) WRITE(numout,*) '--trcsms : C14 OK --  next C14 -- ' 
     73      CALL flush(numout) 
     74# endif 
     75      IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer 
     76# if defined key_debug_medusa 
     77         IF(lwp) WRITE(numout,*) '--trcsms : Age OK --  Continue  -- ' 
     78      CALL flush(numout) 
     79# endif 
    5380      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
    5481 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r6487 r8155  
    5555      !!              Update the passive tracers 
    5656      !!------------------------------------------------------------------- 
     57 
     58      USE dom_oce, ONLY: narea 
     59 
    5760      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index 
    5861      INTEGER               ::  jk, jn  ! dummy loop indices 
     
    8790         tra(:,:,:,:) = 0.e0 
    8891         ! 
     92# if defined key_debug_medusa 
     93         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 
     94         CALL flush(numout) 
     95# endif 
    8996                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
     97# if defined key_debug_medusa 
     98                                   CALL trc_rst_stat  
     99                                   CALL trc_rst_tra_stat 
     100# endif 
    90101         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    91102         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
     
    93104         ENDIF 
    94105                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources 
     106# if defined key_debug_medusa 
     107         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 
     108         CALL trc_rst_stat 
     109         CALL trc_rst_tra_stat 
     110         CALL flush(numout) 
     111# endif 
    95112                                   CALL trc_trp      ( kt )       ! transport of passive tracers 
     113# if defined key_debug_medusa 
     114         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 
     115         CALL trc_rst_stat 
     116         CALL trc_rst_tra_stat 
     117         CALL flush(numout) 
     118# endif 
    96119         IF( kt == nittrc000 ) THEN 
    97120            CALL iom_close( numrtr )       ! close input tracer restart file 
     
    102125         ! 
    103126         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    104          ! 
    105       ENDIF 
    106       ! 
    107       ztrai = 0._wp                                                   !  content of all tracers 
    108       DO jn = 1, jptra 
    109          ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    110       END DO 
    111       IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot 
    112 9300  FORMAT(i10,e18.10) 
     127# if defined key_debug_medusa 
     128         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 
     129         CALL flush(numout) 
     130# endif 
     131         ! 
     132      ENDIF 
     133      ! 
     134      IF (ln_ctl) THEN  
     135         ! The following code is very expensive since it involves multiple  
     136         ! reproducible global sums over all tracer fields and is potentially   
     137         ! called on every timestep. The results it produces are purely for  
     138         ! informational purposes and do not affect model evolution.  
     139         ! Hence we restrict its use by protecting it with the ln_ctl RTL  
     140         ! which should normally only be used under debugging conditions  
     141         ! and not in operational runs. We also need to restrict output   
     142         ! to the master PE since there's no point duplicating the same results  
     143         ! on all processors.     
     144         ztrai = 0._wp                                                   !  content of all tracers 
     145         DO jn = 1, jptra 
     146            ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     147         END DO 
     148         IF( numstr /= -1 ) WRITE(numstr,9300) kt,  ztrai / areatot 
     1499300     FORMAT(i10,e18.10) 
     150      ENDIF 
    113151      ! 
    114152      IF( nn_timing == 1 )   CALL timing_stop('trc_stp') 
  • branches/UKMO/dev_r5518_GO6_MEDUSA_dummyrun/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r7203 r8155  
    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 
     
    2122   USE trcwri_c14b 
    2223   USE trcwri_my_trc 
     24   USE trcwri_medusa 
     25   USE trcwri_idtra 
     26   USE trcwri_age 
    2327 
    2428   IMPLICIT NONE 
     
    5761      ! --------------------------------------- 
    5862      IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES  
     63      IF( lk_medusa  )   CALL trc_wri_medusa     ! MESDUSA 
     64      IF( lk_idtra   )   CALL trc_wri_idtra       ! Idealize tracers 
    5965      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6066      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
     67      IF( lk_age     )   CALL trc_wri_age        ! AGE tracer 
    6168      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
    6269      ! 
Note: See TracChangeset for help on using the changeset viewer.