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_fix_key_comp/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/UKMO/dev_r5518_GO6_fix_key_comp/NEMOGCM/NEMO/TOP_SRC/trcstat.F90 @ 9991

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

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