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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/stpctl.F90 @ 4428

Last change on this file since 4428 was 4413, checked in by trackstand2, 10 years ago

Remove debug output from stpctl
  • Property svn:keywords set to Id
File size: 8.9 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 in_out_manager  ! I/O manager
20   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
21   USE lib_mpp         ! distributed memory computing
22   USE dynspg_oce      ! pressure gradient schemes
23   USE c1d             ! 1D vertical configuration
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC stp_ctl           ! routine called by step.F90
29
30   !! * Control permutation of array indices
31#  include "oce_ftrans.h90"
32#  include "dom_oce_ftrans.h90"
33
34   !!----------------------------------------------------------------------
35   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
36   !! $Id$
37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39
40CONTAINS
41
42   SUBROUTINE stp_ctl( kt, kindic )
43      !!----------------------------------------------------------------------
44      !!                    ***  ROUTINE stp_ctl  ***
45      !!                     
46      !! ** Purpose :   Control the run
47      !!
48      !! ** Method  : - Save the time step in numstp
49      !!              - Print it each 50 time steps
50      !!              - Print solver statistics in numsol
51      !!              - Stop the run IF problem for the solver ( indec < 0 )
52      !!
53      !! ** Actions :   'time.step' file containing the last ocean time-step
54      !!               
55      !!----------------------------------------------------------------------
56      !USE arpdebugging, ONLY: dump_array
57      IMPLICIT none
58      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
59      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
60      !!
61      INTEGER  ::   ji, jj, jk              ! dummy loop indices
62      INTEGER  ::   ii, ij, ik              ! temporary integers
63      REAL(wp) ::   zumax, zsmin, zssh2     ! temporary scalars
64      INTEGER, DIMENSION(3) ::   ilocu      !
65      INTEGER, DIMENSION(2) ::   ilocs      !
66      !!----------------------------------------------------------------------
67
68      !WRITE(*,*) narea,': ARPDBG: stp_ctl start, step=',kt
69      !IF(kt == 1)THEN
70      !   CALL dump_array(kt,'tmask_i',tmask_i,withHalos=.TRUE.)
71      !END IF
72
73      IF( kt == nit000 .AND. lwp ) THEN
74         WRITE(numout,*)
75         WRITE(numout,*) 'stp_ctl : time-stepping control'
76         WRITE(numout,*) '~~~~~~~'
77         ! open time.step file
78         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
79      ENDIF
80
81!! DCSE_NEMO: commenting out these two lines. Do they mess up the profile?
82!     IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
83!     IF(lwp) REWIND( numstp )                       !  --------------------------
84
85      !                                              !* Test maximum of velocity (zonal only)
86      !                                              !  ------------------------
87      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
88      zumax = 0.e0
89#if defined key_z_first
90      DO jj = 1, jpj
91         DO ji = 1, jpi
92            DO jk = 1, jpk
93#else
94      DO jk = 1, jpk
95         DO jj = 1, jpj
96            DO ji = 1, jpi
97#endif
98               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
99          END DO
100        END DO
101      END DO       
102      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
103      !
104      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
105      !
106      IF( zumax > 20.e0 ) THEN
107         IF( lk_mpp ) THEN
108            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
109         ELSE
110            ilocu = MAXLOC( ABS( un(:,:,:) ) )
111            ii = ilocu(1) + nimpp - 1
112            ij = ilocu(2) + njmpp - 1
113            ik = ilocu(3)
114         ENDIF
115         IF(lwp) THEN
116            WRITE(numout,cform_err)
117            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
118            WRITE(numout,*) ' ====== '
119            WRITE(numout,9400) kt, zumax, ii, ij, ik
120            WRITE(numout,*)
121            WRITE(numout,*) '          output of last fields in numwso'
122         ENDIF
123         kindic = -3
124      ENDIF
1259400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
126
127      !                                              !* Test minimum of salinity
128      !                                              !  ------------------------
129      !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
130      zsmin = 100.e0
131      DO jj = 2, jpjm1
132         DO ji = 1, jpi
133#if defined key_z_first
134            IF( tmask_1(ji,jj) == 1)  zsmin = MIN(zsmin,sn(ji,jj,1))
135#else
136            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1))
137#endif
138         END DO
139      END DO
140      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
141      !
142      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
143      !
144      IF( zsmin < 0.) THEN
145         IF (lk_mpp) THEN
146#if defined key_z_first
147            CALL mpp_minloc ( sn(:,:,1),tmask_1(:,:), zsmin, ii,ij )
148#else
149            CALL mpp_minloc ( sn(:,:,1),tmask(:,:,1), zsmin, ii,ij )
150#endif
151         ELSE
152#if defined key_z_first
153            ilocs = MINLOC( sn(:,:,1), mask = tmask_1(:,:) == 1.e0 )
154#else
155            ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )
156#endif
157            ii = ilocs(1) + nimpp - 1
158            ij = ilocs(2) + njmpp - 1
159         ENDIF
160         !
161         IF(lwp) THEN
162            WRITE(numout,cform_err)
163            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
164            WRITE(numout,*) '======= '
165            WRITE(numout,9500) kt, zsmin, ii, ij
166            WRITE(numout,*)
167            WRITE(numout,*) '          output of last fields in numwso'
168         ENDIF
169         kindic = -3
170      ENDIF
1719500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
172
173     
174      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
175
176      ! log file (solver or ssh statistics)
177      ! --------
178      IF( lk_dynspg_flt ) THEN      ! elliptic solver statistics (if required)
179         !
180         IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps       ! Solver
181         !
182         IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN   ! create a abort file if problem found
183            IF(lwp) THEN
184               WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
185               WRITE(numout,*) ' ====== '
186               WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
187               WRITE(numout,*)
188               WRITE(numout,*) ' stpctl: output of last fields'
189               WRITE(numout,*) ' ======  '
190            ENDIF
191         ENDIF
192         !
193      ELSE                                   !* ssh statistics (and others...)
194         IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
195            CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
196         ENDIF
197         !
198         !WRITE(*,*) narea,': ARPDBG: calc zssh2, step=',kt
199         !zssh2 = SUM( sshn(:,:) )
200         !WRITE(*,*) narea,': ARPDBG: sum of sshn = ',zssh2,' at step=',kt
201         !zssh2 = SUM( tmask_i(:,:) )
202         !WRITE(*,*) narea,': ARPDBG: sum of tmask_i = ',zssh2,' at step=',kt
203         zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
204         !WRITE(*,*) narea,': ARPDBG: mpp_sum for zssh2 (',zssh2,'), step=',kt
205         IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
206         !
207         IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
208         !
209      ENDIF
210
211      !WRITE(*,*) narea,': ARPDBG: stp_ctl end, step=',kt
212
2139200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 )
2149300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10)
215      !
216   END SUBROUTINE stp_ctl
217
218   !!======================================================================
219END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.