Ignore:
Timestamp:
2017-07-05T10:28:51+02:00 (4 years ago)
Author:
timgraham
Message:

331: Merge of MEDUSA stable branch and HadGEM3 coupling branches into GO6 package branch.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r7203 r8280  
    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 
Note: See TracChangeset for help on using the changeset viewer.