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

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

Ignore:
Timestamp:
2017-12-22T13:26:37+01:00 (6 years ago)
Author:
frrh
Message:

Add code from Julien Palmieri's Met Office GMED ticket 338.
This incorporates code from branches/NERC/dev_r5518_GO6_package_trdtrc
revisions 8454:9020 inclusive.

Location:
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC
Files:
11 edited
1 copied

Legend:

Unmodified
Added
Removed

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

    r8442 r9163  
    2424   USE trdtrc 
    2525   USE iom           ! I/O library 
     26   USE wrk_nemo 
    2627 
    2728   IMPLICIT NONE 
    … …  
    5455   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm 
    5556   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv  
     57 
     58   !! trend temporary array: 
     59   REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcfc 
    5660 
    5761   !! * Substitutions 
    … …  
    265269      ! 
    266270      IF( l_trdtrc ) THEN 
     271          CALL wrk_alloc( jpi, jpj, jpk, ztrcfc ) 
    267272          DO jn = jp_cfc0, jp_cfc1 
    268             CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     273             ztrcfc(:,:,:) = tra(:,:,:,jn) 
     274            CALL trd_trc( ztrcfc, jn, jptra_sms, kt )   ! save trends 
    269275          END DO 
     276          CALL wrk_dealloc( jpi, jpj, jpk, ztrcfc ) 
    270277      END IF 
    271278      ! 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_update.F90

    r8521 r9163  
    7575      USE lib_mpp,           ONLY: ctl_stop 
    7676      USE par_kind,          ONLY: wp 
    77       USE par_medusa,        ONLY: jp_medusa,                                & 
     77      USE par_medusa,        ONLY: jp_medusa, jp_msa0, jp_msa1,              & 
    7878                                   jpalk, jpchd, jpchn, jpdet, jpdic,        & 
    7979                                   jpdin, jpdtc, jpfer, jpoxy, jppds,        & 
    … …  
    8383                                   jpoxy_lc, jppds_lc, jpphd_lc, jpphn_lc,   & 
    8484                                   jpsil_lc, jpzme_lc, jpzmi_lc 
    85       USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1 
     85      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1, jpk 
    8686      USE par_trc,           ONLY: jptra 
    8787      USE sms_medusa,        ONLY: friver_dep,                               & 

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

    r8521 r9163  
    2323   USE trcsed_medusa 
    2424   USE trcavg_medusa 
     25   !! for SMS trends 
     26   USE par_medusa,    ONLY: jp_msa0, jp_msa1, jp_medusa 
     27   USE par_oce,       ONLY: jpi, jpj, jpk 
     28   USE trd_oce,       ONLY: jptra_sms, l_trdtrc 
     29   USE trdtrc 
    2530 
    2631 
    … …  
    4752      !!---------------------------------------------------------------------- 
    4853      INTEGER, INTENT(in) :: kt   ! ocean time-step index 
     54      !! Loop variables 
     55      INTEGER :: jn 
     56      !! trend temporary array: 
     57      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrmed 
     58 
    4959 
    5060# if defined key_debug_medusa 
    … …  
    5868       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    5969      ENDIF 
     70 
     71      !! MEDUSA SMS trends: 
     72      IF( l_trdtrc ) THEN 
     73          CALL wrk_alloc( jpi, jpj, jpk, jp_medusa, ztrmed ) 
     74          ztrmed(:,:,:,:)=0.0   
     75          DO jn = 1, jp_medusa 
     76            ztrmed(:,:,:,jn) = tra(:,:,:,jp_msa0 + jn - 1) 
     77          END DO 
     78      END IF 
    6079 
    6180      CALL trc_avg_medusa( kt ) ! rolling average module 
    … …  
    97116# endif 
    98117 
     118      !! MEDUSA SMS trends: 
     119      IF( l_trdtrc ) THEN 
     120          DO jn = 1, jp_medusa 
     121            ztrmed(:,:,:,jn) = tra(:,:,:,jp_msa0 + jn - 1)-ztrmed(:,:,:,jn) 
     122            CALL trd_trc( ztrmed(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     123          END DO 
     124          CALL wrk_dealloc( jpi, jpj, jpk, jp_medusa, ztrmed ) 
     125      END IF 
     126 
     127 
    99128   END SUBROUTINE trc_sms_medusa 
    100129    

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r6487 r9163  
    2727   !!---------------------------------------------------------------------- 
    2828   USE oce_trc         ! ocean dynamics and tracers variables 
     29   USE domvvl          ! variable volume   
    2930   USE trc             ! ocean passive tracers variables 
    3031   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3132   USE prtctl_trc      ! Print control for debbuging 
     33   USE trcnam_trp      ! passive tracers transport namelist variables 
    3234   USE trd_oce 
    3335   USE trdtra 
    … …  
    4547   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt 
    4648 
     49   !! * Substitutions 
     50#  include "domzgr_substitute.h90" 
    4751   !!---------------------------------------------------------------------- 
    4852   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    124128      IF( l_trdtrc )  THEN 
    125129         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )  !* store now fields before applying the Asselin filter 
    126          ztrdt(:,:,:,:)  = trn(:,:,:,:) 
     130         ztrdt(:,:,jpk,:) = 0._wp 
     131         IF( ln_trcldf_iso ) THEN                       ! diagnose the "pure" Kz diffusive trend  
     132            DO jn = 1, jptra 
     133               CALL trd_tra( kt, 'TRC', jn, jptra_zdfp, ztrdt(:,:,:,jn) ) 
     134            ENDDO 
     135         ENDIF 
     136         ! total trend for the non-time-filtered variables. 
     137         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn 
     138         ! cancel from tsn terms 
     139         IF( lk_vvl ) THEN 
     140            DO jn = 1, jptra 
     141               DO jk = 1, jpkm1 
     142                  zfact = 1.0 / rdttrc(jk) 
     143                  ztrdt(:,:,jk,jn) = ( tra(:,:,jk,jn)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - & 
     144                                       trn(:,:,jk,jn) ) * zfact 
     145               END DO 
     146            END DO 
     147         ELSE 
     148            DO jn = 1, jptra 
     149               DO jk = 1, jpkm1 
     150                  zfact = 1.0 / rdttrc(jk) 
     151                  ztrdt(:,:,jk,jn) = ( tra(:,:,jk,jn) - trn(:,:,jk,jn) ) * zfact 
     152               END DO 
     153            END DO 
     154         END IF 
     155         DO jn = 1, jptra 
     156            CALL trd_tra( kt, 'TRC', jn, jptra_tot, ztrdt(:,:,:,jn) ) 
     157         ENDDO 
     158         IF( .NOT.lk_vvl )  THEN 
     159            ! Store now fields before applying the Asselin filter  
     160            ! in order to calculate Asselin filter trend later. 
     161            ztrdt(:,:,:,:)  = trn(:,:,:,:) 
     162         ENDIF 
    127163      ENDIF 
    128164      ! Leap-Frog + Asselin filter time stepping 
    … …  
    134170            END DO 
    135171         END DO 
     172         IF (l_trdtrc.AND.lk_vvl) THEN      ! Zero Asselin filter contribution 
     173                                            ! must be explicitly written out since for vvl 
     174                                            ! Asselin filter is output by 
     175                                            ! tra_nxt_vvl that is not called on 
     176                                            ! this time step 
     177            ztrdt(:,:,:,:) = 0._wp 
     178            DO jn = 1, jptra 
     179               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 
     180            ENDDO 
     181         END IF 
     182 
    136183         !                                               
    137184      ELSE 
    … …  
    144191 
    145192      ! trends computation 
    146       IF( l_trdtrc ) THEN                                      ! trends 
     193      IF( l_trdtrc.AND..NOT.lk_vvl) THEN                                      ! trends 
    147194         DO jn = 1, jptra 
    148195            DO jk = 1, jpkm1 
    149196               zfact = 1.e0 / r2dt(jk)   
    150197               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
    151                CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 
    152             END DO 
     198            END DO 
     199            CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 
    153200         END DO 
    154          CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt )  
    155201      END IF 
     202      ! 
     203      IF( l_trdtrc)  CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt )  
    156204      ! 
    157205      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

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

    r8356 r9163  
    140140      DO jn = 1, jptra 
    141141         ! 
    142          IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    143          !                                             ! add the trend to the general tracer trend 
     142         IF( l_trdtrc ) THEN 
     143            ztrtrd(:,:,:) = 0.0 
     144            ztrtrd(:,:,1) = tra(:,:,1,jn)  ! save surface trends 
     145         !                                 ! add the trend to the general tracer trend 
     146         ENDIF 
    144147 
    145148         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice) 
    … …  
    184187         ! 
    185188         IF( l_trdtrc ) THEN 
    186             ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     189            ztrtrd(:,:,1) = tra(:,:,1,jn) - ztrtrd(:,:,1) 
    187190            CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 
    188191         END IF 

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

    r8442 r9163  
    2828   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
    2929# if defined key_debug_medusa 
    30    USE trcrst 
     30   USE trcstat 
    3131# endif 
    3232 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r6486 r9163  
    1515   !!---------------------------------------------------------------------- 
    1616   USE oce_trc         ! ocean dynamics and active tracers 
     17   USE domvvl          ! variable volume        
    1718   USE trc             ! ocean passive tracers variables 
    1819   USE trcnam_trp      ! passive tracers transport namelist variables 
    … …  
    9899 
    99100      IF( l_trdtrc )   THEN                      ! save the vertical diffusive trends for further diagnostics 
     101         !! JPALM -- 18-08-2017 -- vvl case, do as done by G Nurser in trazdf  
     102         IF( lk_vvl ) THEN 
     103            DO jn = 1, jptra 
     104               DO jk = 1, jpkm1 
     105                  ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn)*fse3t_a(:,:,jk) - & 
     106                                          trb(:,:,jk,jn)*fse3t_b(:,:,jk) ) & 
     107                                       / (fse3t_n(:,:,jk)*r2dt(jk)) ) - ztrtrd(:,:,jk,jn) 
     108               END DO 
     109            END DO 
     110         ELSE 
     111            DO jn = 1, jptra 
     112               DO jk = 1, jpkm1 
     113                  ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 
     114               END DO 
     115            END DO 
     116         ENDIF  
    100117         DO jn = 1, jptra 
    101             DO jk = 1, jpkm1 
    102                ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 
    103             END DO 
    104118            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 
    105119         END DO 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90

    r6486 r9163  
    1919   USE trdmxl_trc        ! Mixed layer trends diag. 
    2020   USE iom               ! I/O library 
     21# if defined key_debug_medusa 
     22   USE trcstat,          ONLY: trc_rst_dia_stat      
     23# endif 
    2124 
    2225   IMPLICIT NONE 
    … …  
    8689 
    8790      IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN 
    88          ! 
     91      !! JPALM -- 17-08-2017 -- modif following trd_tra_iom as suggested by Georges 
     92      !!                     -- add jptra_tot; jptra_totad; jptra_zdfp 
     93      !!                     -- shange to output trends every 2 time-step, except tot. 
     94      !!                     -- move cltra and iomput inside the select case 
     95      !!                     So if an non-wanted case arrives here it will not go 
     96      !!                     through cltra (without value) and break iomput. 
     97      !!                     -- Add iom_use in prevision of not using All trends 
     98      !!                     for All passive tracers (will create a HUGE 3D file otherwise -- 
     99      !!                     might be interested in very few of them : SMS and TOT probably) 
     100         ! 
     101         SELECT CASE( ktrd ) 
     102         !! tot - output every time-step: 
     103         CASE( jptra_tot  )       ;    WRITE (cltra,'("TOT_",4a)') 
     104                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     105                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     106         END SELECT 
     107         ! 
     108       IF( MOD( kt, 2 ) == 0 ) THEN 
    89109         SELECT CASE( ktrd ) 
    90110         CASE( jptra_xad  )       ;    WRITE (cltra,'("XAD_",4a)') 
     111                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     112                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
    91113         CASE( jptra_yad  )       ;    WRITE (cltra,'("YAD_",4a)') 
    92          CASE( jptra_zad  )       ;    WRITE (cltra,'("ZAD_",4a)') 
     114                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     115                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     116         CASE( jptra_zad  )       ;    WRITE (cltra,'("ZAD_",4a)')      !! care vvl case 
     117                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     118                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     119         CASE( jptra_totad  )     ;    WRITE (cltra,'("TAD_",4a)')      !! total adv 
     120                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     121                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
    93122         CASE( jptra_ldf  )       ;    WRITE (cltra,'("LDF_",4a)') 
     123                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     124                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
    94125         CASE( jptra_bbl  )       ;    WRITE (cltra,'("BBL_",4a)') 
     126                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     127                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
    95128         CASE( jptra_nsr  )       ;    WRITE (cltra,'("FOR_",4a)') 
     129                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     130                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
    96131         CASE( jptra_zdf  )       ;    WRITE (cltra,'("ZDF_",4a)') 
     132                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     133                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     134         CASE( jptra_zdfp )       ;    WRITE (cltra,'("ZDP_",4a)') 
     135                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     136                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
    97137         CASE( jptra_dmp  )       ;    WRITE (cltra,'("DMP_",4a)') 
     138                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     139                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
    98140         CASE( jptra_sms  )       ;    WRITE (cltra,'("SMS_",4a)') 
     141                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     142                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     143         CASE( jptra_radb )       ;    WRITE (cltra,'("RDB_",4a)') 
     144                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     145                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     146         CASE( jptra_radn )       ;    WRITE (cltra,'("RDN_",4a)') 
     147                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     148                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     149         END SELECT 
     150       ELSE IF( MOD( kt, 2 ) == 1 ) THEN 
     151         SELECT CASE( ktrd ) 
    99152         CASE( jptra_atf  )       ;    WRITE (cltra,'("ATF_",4a)') 
    100          CASE( jptra_radb )       ;    WRITE (cltra,'("RDB_",4a)') 
    101          CASE( jptra_radn )       ;    WRITE (cltra,'("RDN_",4a)') 
    102          END SELECT 
    103                                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
    104                                           CALL iom_put( cltra,  ptrtrd(:,:,:) ) 
     153                           cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     154                           CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     155         END SELECT 
     156       END IF 
    105157         ! 
    106158      END IF 
    … …  
    123175 
    124176   END SUBROUTINE trd_trc_bio 
     177 
     178   SUBROUTINE trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 
     179      !!---------------------------------------------------------------------- 
     180      !!                  ***  ROUTINE trd_trc_iomput  *** 
     181      !!---------------------------------------------------------------------- 
     182      INTEGER, INTENT( in )  ::   kt                                  ! timestep 
     183      INTEGER, INTENT( in )  ::   kjn                                 ! biotrend index 
     184      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! var trend 
     185      CHARACTER (len=*),INTENT( in ) :: cltra                         ! trend name 
     186      !!---------------------------------------------------------------------- 
     187 
     188 
     189      IF  (iom_use(cltra)) THEN 
     190# if defined key_debug_medusa 
     191         IF(lwp) WRITE(numout,*) ' TREND stats (min, max,sum) kt = ',kt ,' jn = ',kjn 
     192         CALL trc_rst_dia_stat( ptrtrd(:,:,1), cltra) 
     193# endif 
     194         CALL iom_put( cltra,  ptrtrd(:,:,:) ) 
     195# if defined key_debug_medusa 
     196      ELSE 
     197         IF(lwp) WRITE(numout,*) & 
     198                      ' TREND -- No output asked for ',cltra,' kt = ',kt,' jn = ',kjn 
     199         CALL trc_rst_dia_stat( ptrtrd(:,:,1), cltra) 
     200# endif 
     201      ENDIF 
     202 
     203   END SUBROUTINE trd_trc_iomput 
     204 
     205 
    125206#else 
    126207   !!---------------------------------------------------------------------- 

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

    r8442 r9163  
    6060      !!                ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA, Age ) 
    6161      !!--------------------------------------------------------------------- 
    62       INTEGER  ::   jn, jk                     ! dummy loop indice 
     62      INTEGER ::  ierr 
     63#if defined key_trdmxl_trc  || defined key_trdtrc 
     64      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
     65         &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
     66         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
     67#endif 
     68 
     69      INTEGER  ::   jn, jk              ! dummy loop indice 
     70      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     71      !!--------------------------------------------------------------------- 
     72 
     73 
    6374      !                                        !   Parameters of the run  
    6475      IF( .NOT. lk_offline ) CALL trc_nam_run 
    … …  
    6879       
    6980      !                                        !   Parameters of additional diagnostics 
    70       CALL trc_nam_dia 
     81      IF( .NOT. lk_iomput )  CALL trc_nam_dia 
    7182 
    7283      !                                        !   namelist of transport 
    … …  
    171182      ENDIF 
    172183 
    173       IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    174       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
     184      IF( lk_c14b    ) THEN  ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
     185      ELSE                   ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    175186      ENDIF 
    176187 

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

    r9114 r9163  
    4343   USE sbc_oce, ONLY: lk_oasis  
    4444   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable 
     45   USE trcstat 
    4546 
    4647   IMPLICIT NONE 
    … …  
    5253   PUBLIC   trc_rst_cal 
    5354   PUBLIC   trc_rst_stat 
    54    PUBLIC   trc_rst_dia_stat 
    55    PUBLIC   trc_rst_tra_stat 
    5655 
    5756   !! * Substitutions 
    … …  
    706705 
    707706 
    708    SUBROUTINE trc_rst_tra_stat 
    709       !!---------------------------------------------------------------------- 
    710       !!                    ***  trc_rst_tra_stat  *** 
    711       !! 
    712       !! ** purpose  :   Compute tracers statistics - check where crazy values appears 
    713       !!---------------------------------------------------------------------- 
    714       INTEGER  :: jk, jn 
    715       REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf 
    716       REAL(wp), DIMENSION(jpi,jpj) :: zvol 
    717       !!---------------------------------------------------------------------- 
    718  
    719       IF( lwp ) THEN 
    720          WRITE(numout,*) 
    721          WRITE(numout,*) '           ----SURFACE TRA STAT----             ' 
    722          WRITE(numout,*) 
    723       ENDIF 
    724       ! 
    725       zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
    726       areasf = glob_sum(zvol(:,:)) 
    727       DO jn = 1, jptra 
    728          ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 
    729          zmin  = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
    730          zmax  = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 
    731          IF( lk_mpp ) THEN 
    732             CALL mpp_min( zmin )      ! min over the global domain 
    733             CALL mpp_max( zmax )      ! max over the global domain 
    734          END IF 
    735          zmean  = ztraf / areasf 
    736          IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 
    737       END DO 
    738       IF(lwp) WRITE(numout,*) 
    739 9001  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
    740       &      '    max :',e18.10) 
    741       ! 
    742    END SUBROUTINE trc_rst_tra_stat 
    743  
    744  
    745  
    746    SUBROUTINE trc_rst_dia_stat( dgtr, names) 
    747       !!---------------------------------------------------------------------- 
    748       !!                    ***  trc_rst_dia_stat  *** 
    749       !! 
    750       !! ** purpose  :   Compute tracers statistics 
    751       !!---------------------------------------------------------------------- 
    752       REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var 
    753       CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name 
    754       !!--------------------------------------------------------------------- 
    755       INTEGER  :: jk, jn 
    756       CHARACTER (LEN=18) :: text_zmean 
    757       REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 
    758       REAL(wp), DIMENSION(jpi,jpj) :: zvol 
    759       !!---------------------------------------------------------------------- 
    760  
    761       IF( lwp )  WRITE(numout,*) 'STAT- ', names 
    762        
    763       ! fse3t_a will be undefined at the start of a run, but this routine 
    764       ! may be called at any stage! Hence we MUST make sure it is  
    765       ! initialised to zero when allocated to enable us to test for  
    766       ! zero content here and avoid potentially dangerous and non-portable  
    767       ! operations (e.g. divide by zero, global sums of junk values etc.)    
    768       zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 
    769       ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 
    770       !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 
    771       areasf = glob_sum(zvol(:,:)) 
    772       zmin  = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
    773       zmax  = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 
    774       IF( lk_mpp ) THEN 
    775          CALL mpp_min( zmin )      ! min over the global domain 
    776          CALL mpp_max( zmax )      ! max over the global domain 
    777       END IF 
    778  
    779       text_zmean = "N/A" 
    780       ! Avoid divide by zero. areasf must be positive. 
    781       IF  (areasf > 0.0) THEN  
    782          zmean = ztraf / areasf 
    783          WRITE(text_zmean,'(e18.10)') zmean 
    784       ENDIF 
    785  
    786       IF(lwp) WRITE(numout,9002) TRIM( names ), text_zmean, zmin, zmax 
    787  
    788   9002  FORMAT(' tracer name :',A,'    mean :',A,'    min :',e18.10, & 
    789       &      '    max :',e18.10 ) 
    790       ! 
    791    END SUBROUTINE trc_rst_dia_stat 
    792  
    793  
    794707#else 
    795708   !!---------------------------------------------------------------------- 

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

    r8442 r9163  
    1919   USE trcwri 
    2020   USE trcrst 
     21   USE trcstat 
    2122   USE trdtrc_oce 
    2223   USE trdmxl_trc 
Note: See TracChangeset for help on using the changeset viewer.