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

Last change on this file since 10149 was 10020, checked in by marc, 2 years ago

GMED ticket 406. CPP key fixes.

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