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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/stpctl.F90 @ 11738

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

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 11.7 KB
Line 
1MODULE stpctl
2   !!======================================================================
3   !!                       ***  MODULE  stpctl  ***
4   !! Ocean run control :  gross check of the ocean time stepping
5   !!======================================================================
6   !! History :  OPA  ! 1991-03  (G. Madec) Original code
7   !!            6.0  ! 1992-06  (M. Imbard)
8   !!            8.0  ! 1997-06  (A.M. Treguier)
9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
10   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   stp_ctl      : Control the run
15   !!----------------------------------------------------------------------
16   USE oce             ! ocean dynamics and tracers variables
17   USE dom_oce         ! ocean space and time domain variables
18   USE sol_oce         ! ocean space and time domain variables
19   USE sbc_oce         ! surface boundary conditions variables
20   USE in_out_manager  ! I/O manager
21   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
22   USE lib_mpp         ! distributed memory computing
23   USE dynspg_oce      ! pressure gradient schemes
24   USE c1d             ! 1D vertical configuration
25
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC stp_ctl           ! routine called by step.F90
31   !!----------------------------------------------------------------------
32   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
33   !! $Id$
34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
35   !!----------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE stp_ctl( kt, kindic )
40      !!----------------------------------------------------------------------
41      !!                    ***  ROUTINE stp_ctl  ***
42      !!                     
43      !! ** Purpose :   Control the run
44      !!
45      !! ** Method  : - Save the time step in numstp
46      !!              - Print it each 50 time steps
47      !!              - Print solver statistics in numsol
48      !!              - Stop the run IF problem for the solver ( indec < 0 )
49      !!
50      !! ** Actions :   'time.step' file containing the last ocean time-step
51      !!               
52      !!----------------------------------------------------------------------
53      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
54      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
55      !!
56      CHARACTER(len = 32) ::        clfname ! time stepping output file name
57      INTEGER  ::   ji, jj, jk              ! dummy loop indices
58      INTEGER  ::   ii, ij, ik              ! temporary integers
59      REAL(wp) ::   zumax, zsmin, zssh2     ! temporary scalars
60      REAL(wp) ::   ztmax, ztmin            ! Scalar to get temperature extreme
61                                            ! values and warn if they're out of Range
62      INTEGER, DIMENSION(3) ::   ilocu      !
63      INTEGER, DIMENSION(2) ::   ilocs      !
64      LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns
65      !!----------------------------------------------------------------------
66      ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
67      ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat )
68      ll_wrtruns = ll_colruns .AND. lwm
69      IF( kt == nit000 .AND. lwp ) THEN
70         WRITE(numout,*)
71         WRITE(numout,*) 'stp_ctl : time-stepping control'
72         WRITE(numout,*) '~~~~~~~'
73         IF(lflush) CALL flush(numout)
74         ! open time.step file with special treatment for SAS
75         IF ( nn_components == jp_iam_sas ) THEN
76            clfname = 'time.step.sas'
77         ELSE
78            clfname = 'time.step'
79         ENDIF
80         IF( lwm ) &
81     &    CALL ctl_opn( numstp, TRIM(clfname), 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
82      ENDIF
83
84      IF(lwm .AND. ll_wrtstp) THEN
85         WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
86         REWIND( numstp )                       !  --------------------------
87      ENDIF
88
89      !                                              !* Test maximum of velocity (zonal only)
90      !                                              !  ------------------------
91      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
92      zumax = 0.e0
93      DO jk = 1, jpk
94         DO jj = 1, jpj
95            DO ji = 1, jpi
96               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
97          END DO
98        END DO
99      END DO       
100      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
101      !
102      IF( ll_colruns )   THEN
103         WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
104         IF(lflush) CALL flush(numout)
105      ENDIF
106      !
107      IF( zumax > 20.e0 ) THEN
108         IF( lk_mpp ) THEN
109            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
110         ELSE
111            ilocu = MAXLOC( ABS( un(:,:,:) ) )
112            ii = ilocu(1) + nimpp - 1
113            ij = ilocu(2) + njmpp - 1
114            ik = ilocu(3)
115         ENDIF
116         IF(lwp) THEN
117            WRITE(numout,cform_err)
118            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
119            WRITE(numout,*) ' ====== '
120            WRITE(numout,9400) kt, zumax, ii, ij, ik
121            WRITE(numout,*)
122            WRITE(numout,*) '          output of last fields in numwso'
123            IF(lflush) CALL flush(numout)
124         ENDIF
125         kindic = -3
126      ENDIF
1279400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
128
129      !                                              !* Test minimum of salinity
130      !                                              !  ------------------------
131      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
132      zsmin = 100.e0
133      DO jj = 2, jpjm1
134         DO ji = 1, jpi
135            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
136         END DO
137      END DO
138      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
139      !
140      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   THEN
141         WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
142         IF(lflush) CALL flush(numout)
143      ENDIF
144      !
145      IF( zsmin < 0.) THEN
146         IF (lk_mpp) THEN
147            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
148         ELSE
149            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
150            ii = ilocs(1) + nimpp - 1
151            ij = ilocs(2) + njmpp - 1
152         ENDIF
153         !
154         IF(lwp) THEN
155            WRITE(numout,cform_err)
156            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
157            WRITE(numout,*) '======= '
158            WRITE(numout,9500) kt, zsmin, ii, ij
159            WRITE(numout,*)
160            WRITE(numout,*) '          output of last fields in numwso'
161         ENDIF
162         kindic = -3
163      ENDIF
1649500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
165
166! ====================================================================================================
167! ====================================================================================================
168      !                                              !AXY (25/10/17)
169      !                                              !* Test max/min limits of temperature
170      !                                              !  ----------------------------------
171      ztmax =  -5.e0  ! arbitrary  low maximum value
172      ztmin = 100.e0  ! arbitrary high minimum value
173      DO jj = 2, jpjm1
174         DO ji = 2, jpim1
175            IF( tmask(ji,jj,1) == 1) THEN
176               ztmax = MAX(ztmax,tsn(ji,jj,1,jp_tem))     ! find local maximum
177               ztmin = MIN(ztmin,tsn(ji,jj,1,jp_tem))     ! find local minimum
178            ENDIF
179         END DO
180      END DO
181      IF( lk_mpp )   CALL mpp_max( ztmax )                ! max over the global domain
182      IF( lk_mpp )   CALL mpp_min( ztmin )                ! min over the global domain
183      !
184      IF( ztmax > 40.) THEN  ! we've got a problem
185         IF (lk_mpp) THEN
186            CALL mpp_maxloc ( tsn(:,:,1,jp_tem),tmask(:,:,1), ztmax, ii,ij )
187         ELSE
188            ilocs = MAXLOC( tsn(:,:,1,jp_tem), mask = tmask(:,:,1) == 1.e0 )
189            ii = ilocs(1) + nimpp - 1
190            ij = ilocs(2) + njmpp - 1
191         ENDIF
192         !
193         IF(lwp) THEN
194            WRITE(numout,*) 'stp_ctl:tracer anomaly: *****    WARNING     *****'
195            WRITE(numout,*) 'stp_ctl:tracer anomaly: sea surface temperature > 40C'
196            WRITE(numout,9600) kt, ztmax, ii, ij
197            WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** END OF WARNING *****'
198            IF(lflush) CALL flush(numout)
199         ENDIF
200      ENDIF
201      !
202      IF( ztmin < -10.) THEN  ! we've got a problem
203         IF (lk_mpp) THEN
204            CALL mpp_minloc ( tsn(:,:,1,jp_tem),tmask(:,:,1), ztmin, ii,ij )
205         ELSE
206            ilocs = MINLOC( tsn(:,:,1,jp_tem), mask = tmask(:,:,1) == 1.e0 )
207            ii = ilocs(1) + nimpp - 1
208            ij = ilocs(2) + njmpp - 1
209         ENDIF
210         !
211         IF(lwp) THEN
212            WRITE(numout,*) 'stp_ctl:tracer anomaly: *****    WARNING     *****'
213            WRITE(numout,*) 'stp_ctl:tracer anomaly: sea surface temperature < -10C'
214            WRITE(numout,9700) kt, ztmin, ii, ij
215            WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** END OF WARNING *****'
216            IF(lflush) CALL flush(numout)
217         ENDIF
218      ENDIF
2199600  FORMAT ('stp_ctl:tracer anomaly: kt=',i6,' max SST: ',f16.10,', i j: ',2i5)
2209700  FORMAT ('stp_ctl:tracer anomaly: kt=',i6,' min SST: ',f16.10,', i j: ',2i5)
221! ====================================================================================================
222! ====================================================================================================
223     
224      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
225
226      ! log file (solver or ssh statistics)
227      ! --------
228      IF( lk_dynspg_flt ) THEN      ! elliptic solver statistics (if required)
229         !
230         IF(ll_wrtruns) THEN
231            WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps       ! Solver
232            IF(lflush) CALL flush(numsol)
233         ENDIF
234         !
235         IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN   ! create a abort file if problem found
236            IF(lwp) THEN
237               WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
238               WRITE(numout,*) ' ====== '
239               WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
240               WRITE(numout,*)
241               WRITE(numout,*) ' stpctl: output of last fields'
242               WRITE(numout,*) ' ======  '
243               IF(lflush) CALL flush(numout)
244            ENDIF
245         ENDIF
246         !
247      ELSE                                   !* ssh statistics (and others...)
248         IF( kt == nit000 .AND. lwm ) THEN   ! open ssh statistics file (put in solver.stat file)
249            CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
250         ENDIF
251         !
252         IF( ll_colruns ) THEN
253            zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
254            IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
255         !
256            WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
257            IF(lflush) CALL flush(numsol)
258         ENDIF
259         !
260      ENDIF
261
2629200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 )
2639300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10)
264      !
265   END SUBROUTINE stp_ctl
266
267   !!======================================================================
268END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.