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.
trcstat.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcstat.F90 @ 9163

Last change on this file since 9163 was 9163, checked in by frrh, 6 years ago

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.

File size: 6.6 KB
RevLine 
[8467]1MODULE trcstat
2   !!======================================================================
3   !!                         ***  MODULE trcrst  ***
4   !! TOP :   Manage the passive tracer restart
5   !!======================================================================
6   !! History :    -   !  1991-03  ()  original code
7   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
8   !!              -   !  2005-10 (C. Ethe) print control
9   !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture
10   !!----------------------------------------------------------------------
11#if defined key_top
12   !!----------------------------------------------------------------------
13   !!   'key_top'                                                TOP models
14   !!----------------------------------------------------------------------
15   !!----------------------------------------------------------------------
16   !!   trc_rst :   Restart for passive tracer
17   !!----------------------------------------------------------------------
18   !!----------------------------------------------------------------------
19   !!   'key_top'                                                TOP models
20   !!----------------------------------------------------------------------
21   !!   trc_rst_opn    : open  restart file
22   !!   trc_rst_read   : read  restart file
23   !!   trc_rst_wri    : write restart file
24   !!----------------------------------------------------------------------
25   USE trc,               ONLY: tra, ctrcnm
26   USE par_kind,          ONLY: wp
27   USE in_out_manager,    ONLY: lwp, numout
28   USE par_oce,           ONLY: jpi, jpj
29   USE par_trc,           ONLY: jptra
30   USE dom_oce,           ONLY: e3t_0, e3t_a, e3t_n, gdepw_0, gdepw_n,     &
31                          tmask, e1e2t
32   !* MPP library                         
33   USE lib_mpp
34   !* Fortran utilities                         
35   USE lib_fortran
36
37   IMPLICIT NONE
38   PRIVATE
39
40   PUBLIC   trc_rst_dia_stat
41   PUBLIC   trc_rst_tra_stat
42
43   !! * Substitutions
44#  include "top_substitute.h90"
45   
46CONTAINS
47   
48   SUBROUTINE trc_rst_tra_stat
49      !!----------------------------------------------------------------------
50      !!                    ***  trc_rst_tra_stat  ***
51      !!
52      !! ** purpose  :   Compute tracers statistics - check where crazy values appears
53      !!----------------------------------------------------------------------
54      INTEGER  :: jk, jn
55      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf
56      REAL(wp), DIMENSION(jpi,jpj) :: zvol
57      !!----------------------------------------------------------------------
58
59      IF( lwp ) THEN
60         WRITE(numout,*)
61         WRITE(numout,*) '           ----SURFACE TRA STAT----             '
62         WRITE(numout,*)
63      ENDIF
64      !
65      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)
66      areasf = glob_sum(zvol(:,:))
67      DO jn = 1, jptra
68         ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) )
69         zmin  = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) )
70         zmax  = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) )
71         IF( lk_mpp ) THEN
72            CALL mpp_min( zmin )      ! min over the global domain
73            CALL mpp_max( zmax )      ! max over the global domain
74         END IF
75         zmean  = ztraf / areasf
76         IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax
77      END DO
78      IF(lwp) WRITE(numout,*)
799001  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
80      &      '    max :',e18.10)
81      !
82   END SUBROUTINE trc_rst_tra_stat
83
84
85
86   SUBROUTINE trc_rst_dia_stat( dgtr, names)
87      !!----------------------------------------------------------------------
88      !!                    ***  trc_rst_dia_stat  ***
89      !!
90      !! ** purpose  :   Compute tracers statistics
91      !!----------------------------------------------------------------------
92      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var
93      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name
94      !!---------------------------------------------------------------------
95      INTEGER  :: jk, jn
96      CHARACTER (LEN=18) :: text_zmean
97      REAL(wp) :: ztraf, zmin, zmax, zmean, areasf
98      REAL(wp), DIMENSION(jpi,jpj) :: zvol
99      !!----------------------------------------------------------------------
100
101      IF( lwp )  WRITE(numout,*) 'STAT- ', names
102     
103      ! fse3t_a will be undefined at the start of a run, but this routine
104      ! may be called at any stage! Hence we MUST make sure it is
105      ! initialised to zero when allocated to enable us to test for
106      ! zero content here and avoid potentially dangerous and non-portable
107      ! operations (e.g. divide by zero, global sums of junk values etc.)   
108      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)
109      ztraf = glob_sum( dgtr(:,:) * zvol(:,:) )
110      !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) )
111      areasf = glob_sum(zvol(:,:))
112      zmin  = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )
113      zmax  = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )
114      IF( lk_mpp ) THEN
115         CALL mpp_min( zmin )      ! min over the global domain
116         CALL mpp_max( zmax )      ! max over the global domain
117      END IF
118
119      text_zmean = "N/A"
120      ! Avoid divide by zero. areasf must be positive.
121      IF  (areasf > 0.0) THEN
122         zmean = ztraf / areasf
123         WRITE(text_zmean,'(e18.10)') zmean
124      ENDIF
125
126      IF(lwp) WRITE(numout,9002) TRIM( names ), text_zmean, zmin, zmax
127
128  9002  FORMAT(' tracer name :',A,'    mean :',A,'    min :',e18.10, &
129      &      '    max :',e18.10 )
130      !
131   END SUBROUTINE trc_rst_dia_stat
132
133
134#else
135   !!----------------------------------------------------------------------
136   !!  Dummy module :                                     No passive tracer
137   !!----------------------------------------------------------------------
138CONTAINS
139   SUBROUTINE trc_rst_dia_stat                      ! Empty routines
140      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?'
141   END SUBROUTINE trc_rst_dia_stat
142   SUBROUTINE trc_rst_dia_stat( dgtr, names)
143      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var
144      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name
145      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?'
146   END SUBROUTINE trc_rst_dia_stat 
147#endif
148
149   !!----------------------------------------------------------------------
150   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
151   !! $Id$
152   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
153   !!======================================================================
154END MODULE trcstat
Note: See TracBrowser for help on using the repository browser.