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

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/trcstat.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.
File size: 8.1 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   USE yomhook, ONLY: lhook, dr_hook
40   USE parkind1, ONLY: jprb, jpim
41
42   IMPLICIT NONE
43   PRIVATE
44
45   PUBLIC   trc_rst_dia_stat
46   PUBLIC   trc_rst_tra_stat
47
48   !! * Substitutions
49#  include "top_substitute.h90"
50   
51CONTAINS
52   
53   SUBROUTINE trc_rst_tra_stat
54      !!----------------------------------------------------------------------
55      !!                    ***  trc_rst_tra_stat  ***
56      !!
57      !! ** purpose  :   Compute tracers statistics - check where crazy values appears
58      !!----------------------------------------------------------------------
59      INTEGER  :: jk, jn
60      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf
61      REAL(wp), DIMENSION(jpi,jpj) :: zvol
62      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
63      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
64      REAL(KIND=jprb)               :: zhook_handle
65
66      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_RST_TRA_STAT'
67
68      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
69
70      !!----------------------------------------------------------------------
71
72      IF( lwp ) THEN
73         WRITE(numout,*)
74         WRITE(numout,*) '           ----SURFACE TRA STAT----             '
75         WRITE(numout,*)
76      ENDIF
77      !
78      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)
79      areasf = glob_sum(zvol(:,:))
80      DO jn = 1, jptra
81         ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) )
82         zmin  = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) )
83         zmax  = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) )
84         IF( lk_mpp ) THEN
85            CALL mpp_min( zmin )      ! min over the global domain
86            CALL mpp_max( zmax )      ! max over the global domain
87         END IF
88         zmean  = ztraf / areasf
89         IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax
90      END DO
91      IF(lwp) WRITE(numout,*)
929001  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
93      &      '    max :',e18.10)
94      !
95      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
96   END SUBROUTINE trc_rst_tra_stat
97
98
99
100   SUBROUTINE trc_rst_dia_stat( dgtr, names)
101      !!----------------------------------------------------------------------
102      !!                    ***  trc_rst_dia_stat  ***
103      !!
104      !! ** purpose  :   Compute tracers statistics
105      !!----------------------------------------------------------------------
106      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var
107      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name
108      !!---------------------------------------------------------------------
109      INTEGER  :: jk, jn
110      CHARACTER (LEN=18) :: text_zmean
111      REAL(wp) :: ztraf, zmin, zmax, zmean, areasf
112      REAL(wp), DIMENSION(jpi,jpj) :: zvol
113      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
114      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
115      REAL(KIND=jprb)               :: zhook_handle
116
117      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_RST_DIA_STAT'
118
119      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
120
121      !!----------------------------------------------------------------------
122
123      IF( lwp )  WRITE(numout,*) 'STAT- ', names
124     
125      ! fse3t_a will be undefined at the start of a run, but this routine
126      ! may be called at any stage! Hence we MUST make sure it is
127      ! initialised to zero when allocated to enable us to test for
128      ! zero content here and avoid potentially dangerous and non-portable
129      ! operations (e.g. divide by zero, global sums of junk values etc.)   
130      zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1)
131      ztraf = glob_sum( dgtr(:,:) * zvol(:,:) )
132      !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) )
133      areasf = glob_sum(zvol(:,:))
134      zmin  = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )
135      zmax  = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) )
136      IF( lk_mpp ) THEN
137         CALL mpp_min( zmin )      ! min over the global domain
138         CALL mpp_max( zmax )      ! max over the global domain
139      END IF
140
141      text_zmean = "N/A"
142      ! Avoid divide by zero. areasf must be positive.
143      IF  (areasf > 0.0) THEN
144         zmean = ztraf / areasf
145         WRITE(text_zmean,'(e18.10)') zmean
146      ENDIF
147
148      IF(lwp) WRITE(numout,9002) TRIM( names ), text_zmean, zmin, zmax
149
150  9002  FORMAT(' tracer name :',A,'    mean :',A,'    min :',e18.10, &
151      &      '    max :',e18.10 )
152      !
153      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
154   END SUBROUTINE trc_rst_dia_stat
155
156
157#else
158   !!----------------------------------------------------------------------
159   !!  Dummy module :                                     No passive tracer
160   !!----------------------------------------------------------------------
161CONTAINS
162   SUBROUTINE trc_rst_dia_stat                      ! Empty routines
163   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
164   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
165   REAL(KIND=jprb)               :: zhook_handle
166
167   CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_RST_DIA_STAT'
168
169   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
170
171      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?'
172   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
173   END SUBROUTINE trc_rst_dia_stat
174   SUBROUTINE trc_rst_dia_stat( dgtr, names)
175      REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) ::   dgtr      ! 2D diag var
176      CHARACTER(len=*)             , INTENT(in) ::   names     ! 2D diag name
177      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
178      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
179      REAL(KIND=jprb)               :: zhook_handle
180
181      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_RST_DIA_STAT'
182
183      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
184
185      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?'
186      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
187   END SUBROUTINE trc_rst_dia_stat 
188#endif
189
190   !!----------------------------------------------------------------------
191   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
192   !! $Id$
193   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
194   !!======================================================================
195END MODULE trcstat
Note: See TracBrowser for help on using the repository browser.