Changeset 7693


Ignore:
Timestamp:
2017-02-17T16:38:26+01:00 (4 years ago)
Author:
frrh
Message:

Merge in branches/NERC/dev_r5518_NOC_MEDUSA_Stable from revision range
r 5711:7611 (i.e. the entire branch)

Location:
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM
Files:
18 edited
17 copied

Legend:

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

    r4147 r7693  
    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_MEDUSA_optim_RH/NEMOGCM/CONFIG/cfg.txt

    r7692 r7693  
    1111ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    1212ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
     13ORCA2_OFF_MEDUSA OPA_SRC OFF_SRC TOP_SRC 
  • branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90

    r7692 r7693  
     1#if ! defined key_top 
    12MODULE trdtrc 
    23   !!====================================================================== 
     
    2223   !!====================================================================== 
    2324END MODULE trdtrc 
     25#endif 
  • branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    r7692 r7693  
    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_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

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

    r7692 r7693  
    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_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r7692 r7693  
    1515   !!   cfc_init     :  sets constants for CFC surface forcing computation 
    1616   !!---------------------------------------------------------------------- 
     17   USE dom_oce       ! ocean space and time domain 
    1718   USE oce_trc       ! Ocean variables 
    1819   USE par_trc       ! TOP parameters 
     
    3132   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file 
    3233   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
     34   INTEGER , PUBLIC            ::   simu_type      ! Kind of simulation: 1- Spin-up  
     35                                                   !                     2- Hindcast/projection 
    3336   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year) 
    3437   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)  
     
    7982      ! 
    8083      INTEGER  ::   ji, jj, jn, jl, jm, js 
    81       INTEGER  ::   iyear_beg, iyear_end 
     84      INTEGER  ::   iyear_beg, iyear_end, iyear_tmp 
    8285      INTEGER  ::   im1, im2, ierr 
    8386      REAL(wp) ::   ztap, zdtap         
     
    103106      ! Temporal interpolation 
    104107      ! ---------------------- 
    105       iyear_beg = nyear - 1900 
     108      !! JPALM -- 15-06-2016 -- define 2 kind of CFC run. 
     109      !!                     we want to make cycle experiments,  
     110      !!                     to periodically compare the ocean dynamic within 
     111      !!                     1- the SPIN-UP and 2- Hincast/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      !!                     correspondance 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      !! 1 -- SPIN-UP 
     121      IF (simu_type==1) THEN 
     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      !! 
     136      !! 2 -- Hindcast/proj 
     137      ELSEIF (simu_type==2) THEN 
     138         iyear_beg = MOD(nyear, 100) 
     139         IF (iyear_beg < 9)  iyear_beg = iyear_beg + 100 
     140         !! JPALM -- Same than previously, if iyear_beg is out of P_cfc range, 
     141         !!       we want to set p_CFC to 0.00 --> set iyear_beg = 10 
     142         IF ((iyear_beg < 30) .OR. (iyear_beg > 107)) iyear_beg = 10              
     143      ENDIF 
     144      !! 
    106145      IF ( nmonth <= 6 ) THEN 
    107146         iyear_beg = iyear_beg - 1 
     
    176215         !                                                  !----------------! 
    177216      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                                             
     217         ! 
     218      IF( kt == nittrc000 ) THEN 
     219         DO jl = 1, jp_cfc    
     220             WRITE(NUMOUT,*) ' ' 
     221             WRITE(NUMOUT,*) 'CFC interpolation verification '  !! Jpalm   
     222             WRITE(NUMOUT,*) '################################## ' 
     223             WRITE(NUMOUT,*) ' ' 
     224               if (jl.EQ.1) then 
     225                   WRITE(NUMOUT,*) 'Traceur = CFC11: ' 
     226               elseif (jl.EQ.2) then 
     227                   WRITE(NUMOUT,*) 'Traceur = CFC12: ' 
     228               endif 
     229             WRITE(NUMOUT,*) 'nyear    = ', nyear 
     230             WRITE(NUMOUT,*) 'nmonth   = ', nmonth 
     231             WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg 
     232             WRITE(NUMOUT,*) 'iyear_end= ', iyear_end 
     233             WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl) 
     234             WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl) 
     235             WRITE(NUMOUT,*) 'Im1= ',im1 
     236             WRITE(NUMOUT,*) 'Im2= ',im2 
     237             WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc 
     238             WRITE(NUMOUT,*) ' ' 
     239         END DO   
     240# if defined key_debug_medusa 
     241         CALL flush(numout) 
     242# endif 
     243      ENDIF 
     244        ! 
     245      !IF( lrst_trc ) THEN 
     246      !   IF(lwp) WRITE(numout,*) 
     247      !   IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   & 
     248      !      &                    'at it= ', kt,' date= ', ndastp 
     249      !   IF(lwp) WRITE(numout,*) '~~~~' 
     250      !   DO jn = jp_cfc0, jp_cfc1 
     251      !      CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
     252      !   END DO 
     253      !ENDIF                                             
    188254      ! 
    189255      IF( lk_iomput ) THEN 
     
    203269      END IF 
    204270      ! 
     271# if defined key_debug_medusa 
     272      IF(lwp) WRITE(numout,*) '   CFC - Check: nn_timing = ', nn_timing 
     273      CALL flush(numout) 
     274# endif 
    205275      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc') 
    206276      ! 
     
    214284      !! ** Purpose : sets constants for CFC model 
    215285      !!--------------------------------------------------------------------- 
    216       INTEGER :: jn 
     286      INTEGER :: jl, jn, iyear_beg, iyear_tmp 
    217287 
    218288      ! coefficient for CFC11  
     
    254324      sca(4,2) =  -0.067430 
    255325 
    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 
     326      !!--------------------------------------------- 
     327      !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle, 
     328      !!       Or if out of P_cfc range 
     329      IF (simu_type==1) THEN 
     330         iyear_tmp = nyear - nyear_res  !! JPALM -- in our spin-up, nyear_res is 1000 
     331         iyear_beg = MOD( iyear_tmp , 90 ) 
     332         !!--------------------------------------- 
     333         IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 
     334            qtr_cfc(:,:,:) = 0._wp 
     335            IF(lwp) THEN 
     336               WRITE(numout,*)  
     337               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 
     338               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --' 
     339               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --' 
     340               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --' 
     341            ENDIF 
     342            qtr_cfc(:,:,:) = 0._wp 
     343            qint_cfc(:,:,:) = 0._wp 
     344            DO jl = 1, jp_cfc 
     345              jn = jp_cfc0 + jl - 1 
     346              trn(:,:,:,jn) = 0._wp 
     347              trb(:,:,:,jn) = 0._wp 
     348            END DO 
     349         ENDIF 
     350      !! 
     351      !! 2 -- Hindcast/proj 
     352      ELSEIF (simu_type==2) THEN 
     353         iyear_beg = MOD(nyear, 100) 
     354         IF (iyear_beg < 9)  iyear_beg = iyear_beg + 100 
     355         IF ((iyear_beg < 30) .OR. (iyear_beg > 107)) THEN 
     356            qtr_cfc(:,:,:) = 0._wp 
     357            IF(lwp) THEN 
     358               WRITE(numout,*) 
     359               WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 
     360               WRITE(numout,*) '                          --    set qtr_CFC = 0.00   --' 
     361               WRITE(numout,*) '                          --   set qint_CFC = 0.00   --' 
     362               WRITE(numout,*) '                          --   set trn(CFC) = 0.00   --' 
     363            ENDIF 
     364            qtr_cfc(:,:,:) = 0._wp 
     365            qint_cfc(:,:,:) = 0._wp 
     366            DO jl = 1, jp_cfc 
     367              jn = jp_cfc0 + jl - 1 
     368              trn(:,:,:,jn) = 0._wp 
     369              trb(:,:,:,jn) = 0._wp 
     370            END DO 
     371         ENDIF 
    264372      ENDIF 
     373 
    265374      IF(lwp) WRITE(numout,*) 
    266375      ! 
  • branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

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

    r7692 r7693  
    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_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

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

    r7692 r7693  
    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_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r7692 r7693  
    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 
     
    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, ATM_XCO2, OCN_FCO2, ATM_FCO2, OCN_RHOSW, OCN_SCHCO2, OCN_KWCO2,          & 
     134                  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   !! -------------------------------------------------- 
  • branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r7692 r7693  
    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 
     
    7781         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 
    7882         & Computation of a daily mean shortwave for some biogeochemical models) ') 
    79  
     83          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     84          !!!!! CHECK For MEDUSA 
     85          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    8086      IF( nn_cla == 1 )   & 
    8187         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
     
    98104 
    99105      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
     106      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
     107      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
    100108      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    101109      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
     110      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer 
    102111      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
    103112 
    104113      CALL trc_ice_ini                                 ! Tracers in sea ice 
     114 
     115# if defined key_debug_medusa 
     116         IF (lwp) write (numout,*) '------------------------------' 
     117         IF (lwp) write (numout,*) 'Jpalm - debug' 
     118         IF (lwp) write (numout,*) ' in trc_init' 
     119         IF (lwp) write (numout,*) ' sms init OK' 
     120         IF (lwp) write (numout,*) ' next: open tracer.stat' 
     121         IF (lwp) write (numout,*) ' ' 
     122         CALL flush(numout) 
     123# endif 
    105124 
    106125      IF( lwp ) THEN 
     
    110129      ENDIF 
    111130 
    112       IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    113  
     131# if defined key_debug_medusa 
     132         IF (lwp) write (numout,*) '------------------------------' 
     133         IF (lwp) write (numout,*) 'Jpalm - debug' 
     134         IF (lwp) write (numout,*) ' in trc_init' 
     135         IF (lwp) write (numout,*) 'open tracer.stat -- OK' 
     136         IF (lwp) write (numout,*) ' ' 
     137         CALL flush(numout) 
     138# endif 
     139 
     140 
     141      IF( ln_trcdta ) THEN 
     142#if defined key_medusa 
     143         IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 
     144         IF(lwp) CALL flush(numout) 
     145#endif 
     146         CALL trc_dta_init(jptra) 
     147      ENDIF 
    114148 
    115149      IF( ln_rsttr ) THEN 
    116150        ! 
     151#if defined key_medusa 
     152        IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 
     153        IF(lwp) CALL flush(numout) 
     154#endif 
    117155        CALL trc_rst_read              ! restart from a file 
    118156        ! 
     
    141179        ENDIF 
    142180        ! 
     181# if defined key_debug_medusa 
     182         IF (lwp) write (numout,*) '------------------------------' 
     183         IF (lwp) write (numout,*) 'Jpalm - debug' 
     184         IF (lwp) write (numout,*) ' in trc_init' 
     185         IF (lwp) write (numout,*) ' before trb = trn' 
     186         IF (lwp) write (numout,*) ' ' 
     187         CALL flush(numout) 
     188# endif 
     189        ! 
    143190        trb(:,:,:,:) = trn(:,:,:,:) 
     191        !  
     192# if defined key_debug_medusa 
     193         IF (lwp) write (numout,*) '------------------------------' 
     194         IF (lwp) write (numout,*) 'Jpalm - debug' 
     195         IF (lwp) write (numout,*) ' in trc_init' 
     196         IF (lwp) write (numout,*) ' trb = trn -- OK' 
     197         IF (lwp) write (numout,*) ' ' 
     198         CALL flush(numout) 
     199# endif 
    144200        !  
    145201      ENDIF 
     
    150206      IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   & 
    151207        &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level 
    152  
    153  
     208      ! 
     209# if defined key_debug_medusa 
     210         IF (lwp) write (numout,*) '------------------------------' 
     211         IF (lwp) write (numout,*) 'Jpalm - debug' 
     212         IF (lwp) write (numout,*) ' in trc_init' 
     213         IF (lwp) write (numout,*) ' partial step -- OK' 
     214         IF (lwp) write (numout,*) ' ' 
     215         CALL flush(numout) 
     216# endif 
    154217      ! 
    155218      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    156219      ! 
    157  
     220# if defined key_debug_medusa 
     221         IF (lwp) write (numout,*) '------------------------------' 
     222         IF (lwp) write (numout,*) 'Jpalm - debug' 
     223         IF (lwp) write (numout,*) ' in trc_init' 
     224         IF (lwp) write (numout,*) ' before initiate tracer contents' 
     225         IF (lwp) write (numout,*) ' ' 
     226         CALL flush(numout) 
     227# endif 
     228      ! 
    158229      trai(:) = 0._wp                                                   ! initial content of all tracers 
    159230      DO jn = 1, jptra 
     
    168239         WRITE(numout,*) '          *** Total inital content of all tracers ' 
    169240         WRITE(numout,*) 
     241# if defined key_debug_medusa 
     242         CALL flush(numout) 
     243# endif 
     244         ! 
     245# if defined key_debug_medusa 
     246         WRITE(numout,*) ' litle check :  ', ctrcnm(1) 
     247         CALL flush(numout) 
     248# endif 
    170249         DO jn = 1, jptra 
    171250            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
     
    180259         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    181260      ENDIF 
     261 
     262      IF(lwp) WRITE(numout,*) 
     263      IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 
     264      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     265      IF(lwp) CALL flush(numout) 
     266# if defined key_debug_medusa 
     267         CALL trc_rst_stat 
     268         CALL flush(numout) 
     269# endif 
     270 
    1822719000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    183272      ! 
  • branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r7692 r7693  
    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_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r7692 r7693  
    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  !! 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, 'B_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      !! calculate stats on these fields 
     276      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 
     277      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 
     278      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 
     279      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 
     280      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 
     281      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 
     282      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 
     283      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 
     284      !!   
     285      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 
     286      !!                  -- needed for monthly call of carb-chem routine and better reproducibility 
     287# if defined key_roam 
     288      IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN 
     289         IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...' 
     290         CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D'   ,  f3_pH(:,:,:)     ) 
     291         CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D',  f3_h2co3(:,:,:)  ) 
     292         CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' ,  f3_hco3(:,:,:)   ) 
     293         CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D'  ,  f3_co3(:,:,:)    ) 
     294         CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D',  f3_omcal(:,:,:)  ) 
     295         CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D',  f3_omarg(:,:,:)  ) 
     296         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' ,  f2_ccd_cal(:,:)  ) 
     297         CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' ,  f2_ccd_arg(:,:)  ) 
     298         !! 
     299         IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 
     300      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf') 
     301      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 
     302      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 
     303      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' ) 
     304      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 
     305      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 
     306      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 
     307      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 
     308 
     309      ELSE 
     310         IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... ' 
     311         IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not ' 
     312         IF(lwp) WRITE(numout,*) 'Check if   mod(kt*rdt,2592000) == rdt'  
     313         IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...'  
     314      ENDIF 
     315# endif 
     316 
     317 
     318#endif 
     319      ! 
     320#if defined key_idtra 
     321      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and  
     322      !!                        writting here undre their key. 
     323      !!                        problems in CFC restart, maybe because of this... 
     324      !!                        and pb in idtra diag or diad-restart writing. 
     325      !!---------------------------------------------------------------------- 
     326      IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN 
     327         !! YES; in which case read them 
     328         !! 
     329         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...' 
     330         CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA',  qint_idtra(:,:,1)  ) 
     331      ELSE 
     332         !! NO; in which case set them to zero 
     333         !! 
     334         IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...' 
     335         qint_idtra(:,:,1)  = 0.0   !! CHN 
     336      ENDIF 
     337      !! 
     338      !! calculate stats on these fields 
     339      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 
     340      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 
     341#endif 
     342      ! 
     343#if defined key_cfc 
     344      DO jl = 1, jp_cfc 
     345         jn = jp_cfc0 + jl - 1 
     346         IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN 
     347            !! YES; in which case read them 
     348            !! 
     349            IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...' 
     350            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
     351         ELSE 
     352            !! NO; in which case set them to zero 
     353            !! 
     354            IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...' 
     355            qint_cfc(:,:,jn)  = 0.0   !! CHN 
     356         ENDIF 
     357         !! 
     358         !! calculate stats on these fields 
     359         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 
     360         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 
     361      END DO 
     362#endif 
    119363      ! 
    120364   END SUBROUTINE trc_rst_read 
     
    128372      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    129373      !! 
    130       INTEGER  :: jn 
     374      INTEGER  :: jn, jl 
    131375      REAL(wp) :: zarak0 
     376      !! AXY (05/11/13): temporary variables 
     377      REAL(wp) ::    fq0,fq1,fq2 
    132378      !!---------------------------------------------------------------------- 
    133379      ! 
     
    142388         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    143389      END DO 
    144       ! 
     390 
     391      !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 
     392      !!                 call to MEDUSA-2 at this point; this suggests that the FCM 
     393      !!                 version of NEMO date significantly earlier than the current 
     394      !!                 version 
     395 
     396#if defined key_medusa 
     397      !! AXY (13/01/12): write out "before" and "now" state of seafloor 
     398      !!                 sediment pools into restart; this happens 
     399      !!                 whether or not the pools are to be used by 
     400      !!                 MEDUSA (which is controlled by a switch in the 
     401      !!                 namelist_top file) 
     402      !! 
     403      IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' 
     404      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N',  zb_sed_n(:,:)  ) 
     405      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N',  zn_sed_n(:,:)  ) 
     406      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) ) 
     407      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) ) 
     408      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) ) 
     409      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) ) 
     410      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C',  zb_sed_c(:,:)  ) 
     411      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C',  zn_sed_c(:,:)  ) 
     412      CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) ) 
     413      CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) ) 
     414      !! 
     415      !! calculate stats on these fields 
     416      IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 
     417      call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment  N') 
     418      call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 
     419      call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 
     420      call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 
     421      call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 
     422      !! 
     423      !! AXY (07/07/15): write out temporally averaged fields for DMS 
     424      !!                 calculations 
     425      !! 
     426      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...' 
     427      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN',  zb_dms_chn(:,:)  ) 
     428      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN',  zn_dms_chn(:,:)  ) 
     429      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD',  zb_dms_chd(:,:)  ) 
     430      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD',  zn_dms_chd(:,:)  ) 
     431      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD',  zb_dms_mld(:,:)  ) 
     432      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD',  zn_dms_mld(:,:)  ) 
     433      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR',  zb_dms_qsr(:,:)  ) 
     434      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR',  zn_dms_qsr(:,:)  ) 
     435      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN',  zb_dms_din(:,:)  ) 
     436      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN',  zn_dms_din(:,:)  ) 
     437         !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 
     438         !!                  -- needed for the coupling with atm 
     439      CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf',  zb_dms_srf(:,:)  ) 
     440      CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf',  zn_dms_srf(:,:)  ) 
     441      CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx',  zb_co2_flx(:,:)  ) 
     442      CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx',  zn_co2_flx(:,:)  ) 
     443      !! 
     444      !! calculate stats on these fields 
     445      IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 
     446      call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 
     447      call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 
     448      call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 
     449      call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 
     450      call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 
     451      call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 
     452      call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 
     453      !! 
     454      IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.' 
     455      call trc_rst_dia_stat(dust(:,:), 'Dust dep') 
     456      call trc_rst_dia_stat(zirondep(:,:), 'Iron dep') 
     457      !!  
     458      !!   
     459      !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 
     460      !!                  -- needed for monthly call of carb-chem routine and better reproducibility 
     461# if defined key_roam 
     462      IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...' 
     463      CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D'   ,  f3_pH(:,:,:)     ) 
     464      CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D',  f3_h2co3(:,:,:)  ) 
     465      CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' ,  f3_hco3(:,:,:)   ) 
     466      CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D'  ,  f3_co3(:,:,:)    ) 
     467      CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D',  f3_omcal(:,:,:)  ) 
     468      CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D',  f3_omarg(:,:,:)  ) 
     469      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' ,  f2_ccd_cal(:,:)  ) 
     470      CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' ,  f2_ccd_arg(:,:)  ) 
     471      !! 
     472      IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 
     473      call trc_rst_dia_stat( f3_pH(:,:,1)   ,'pH 3D surf') 
     474      call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 
     475      call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 
     476      call trc_rst_dia_stat( f3_co3(:,:,1)  ,'CO3 3D surf' ) 
     477      call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 
     478      call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 
     479      call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 
     480      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 
     481      !! 
     482# endif 
     483!! 
     484#endif 
     485      ! 
     486#if defined key_idtra 
     487      !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and  
     488      !!                        writting here undre their key. 
     489      !!                        problems in CFC restart, maybe because of this... 
     490      !!                        and pb in idtra diag or diad-restart writing. 
     491      !!---------------------------------------------------------------------- 
     492      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...' 
     493      CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA',  qint_idtra(:,:,1) ) 
     494      !! 
     495      !! calculate stats on these fields 
     496      IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 
     497      call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 
     498#endif 
     499      ! 
     500#if defined key_cfc 
     501      DO jl = 1, jp_cfc 
     502         jn = jp_cfc0 + jl - 1 
     503         IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...' 
     504         CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 
     505         !! 
     506         !! calculate stats on these fields 
     507         IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 
     508         call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 
     509      END DO 
     510#endif 
     511      ! 
     512 
    145513      IF( kt == nitrst ) THEN 
    146514          CALL trc_rst_stat            ! statistics 
     
    304672         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 
    305673      END DO 
    306       WRITE(numout,*)  
     674      IF(lwp) WRITE(numout,*)  
    3076759000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
    308676      &      '    max :',e18.10,'    drift :',e18.10, ' %') 
    309677      ! 
    310678   END SUBROUTINE trc_rst_stat 
     679 
     680 
     681   SUBROUTINE trc_rst_tra_stat 
     682      !!---------------------------------------------------------------------- 
     683      !!                    ***  trc_rst_tra_stat  *** 
     684      !! 
     685      !! ** purpose  :   Compute tracers statistics - check where crazy values appears 
     686      !!---------------------------------------------------------------------- 
     687      INTEGER  :: jk, jn 
     688      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
     689      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     690      !!---------------------------------------------------------------------- 
     691 
     692      IF( lwp ) THEN 
     693         WRITE(numout,*) 
     694         WRITE(numout,*) '           ----SURFACE TRA STAT----             ' 
     695         WRITE(numout,*) 
     696      ENDIF 
     697      ! 
     698         zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
     699      DO jn = 1, jptra 
     700         ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 
     701         zmin  = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
     702         zmax  = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
     703         IF( lk_mpp ) THEN 
     704            CALL mpp_min( zmin )      ! min over the global domain 
     705            CALL mpp_max( zmax )      ! max over the global domain 
     706         END IF 
     707         zmean  = ztraf / areatot 
     708         IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 
     709      END DO 
     710      IF(lwp) WRITE(numout,*) 
     7119001  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     712      &      '    max :',e18.10) 
     713      ! 
     714   END SUBROUTINE trc_rst_tra_stat 
     715 
     716 
     717 
     718   SUBROUTINE trc_rst_dia_stat( dgtr, names) 
     719      !!---------------------------------------------------------------------- 
     720      !!                    ***  trc_rst_dia_stat  *** 
     721      !! 
     722      !! ** purpose  :   Compute tracers statistics 
     723      !!---------------------------------------------------------------------- 
     724      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var 
     725      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name 
     726      !!--------------------------------------------------------------------- 
     727      INTEGER  :: jk, jn 
     728      REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 
     729      REAL(wp), DIMENSION(jpi,jpj) :: zvol 
     730      !!---------------------------------------------------------------------- 
     731 
     732      IF( lwp )  WRITE(numout,*) 'STAT- ', names 
     733      ! 
     734      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
     735      ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 
     736      areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 
     737      zmin  = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
     738      zmax  = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
     739      IF( lk_mpp ) THEN 
     740         CALL mpp_min( zmin )      ! min over the global domain 
     741         CALL mpp_max( zmax )      ! max over the global domain 
     742      END IF 
     743      zmean  = ztraf / areatot 
     744      IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 
     745      ! 
     746      IF(lwp) WRITE(numout,*) 
     7479002  FORMAT(' tracer name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     748      &      '    max :',e18.10 ) 
     749      ! 
     750   END SUBROUTINE trc_rst_dia_stat 
     751 
    311752 
    312753#else 
  • branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r7692 r7693  
    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_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r7692 r7693  
    8787         tra(:,:,:,:) = 0.e0 
    8888         ! 
     89# if defined key_debug_medusa 
     90         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 
     91         CALL flush(numout) 
     92# endif 
    8993                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
     94# if defined key_debug_medusa 
     95                                   CALL trc_rst_stat  
     96                                   CALL trc_rst_tra_stat 
     97# endif 
    9098         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    9199         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
     
    93101         ENDIF 
    94102                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources 
     103# if defined key_debug_medusa 
     104         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 
     105         CALL trc_rst_stat 
     106         CALL trc_rst_tra_stat 
     107         CALL flush(numout) 
     108# endif 
    95109                                   CALL trc_trp      ( kt )       ! transport of passive tracers 
     110# if defined key_debug_medusa 
     111         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 
     112         CALL trc_rst_stat 
     113         CALL trc_rst_tra_stat 
     114         CALL flush(numout) 
     115# endif 
    96116         IF( kt == nittrc000 ) THEN 
    97117            CALL iom_close( numrtr )       ! close input tracer restart file 
     
    102122         ! 
    103123         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
     124# if defined key_debug_medusa 
     125         IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 
     126         CALL flush(numout) 
     127# endif 
    104128         ! 
    105129      ENDIF 
  • branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r7692 r7693  
    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.