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 @ 3432

Last change on this file since 3432 was 3432, checked in by trackstand2, 12 years ago

Merge branch 'ksection_partition'

  • Property svn:keywords set to Id
File size: 8.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 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      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
57      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
58      !!
59      INTEGER  ::   ji, jj, jk              ! dummy loop indices
60      INTEGER  ::   ii, ij, ik              ! temporary integers
61      REAL(wp) ::   zumax, zsmin, zssh2     ! temporary scalars
62      INTEGER, DIMENSION(3) ::   ilocu      !
63      INTEGER, DIMENSION(2) ::   ilocs      !
64      !!----------------------------------------------------------------------
65
66      !WRITE(*,*) narea,': ARPDBG: stp_ctl start, step=',kt
67
68      IF( kt == nit000 .AND. lwp ) THEN
69         WRITE(numout,*)
70         WRITE(numout,*) 'stp_ctl : time-stepping control'
71         WRITE(numout,*) '~~~~~~~'
72         ! open time.step file
73         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
74      ENDIF
75
76!! DCSE_NEMO: commenting out these two lines. Do they mess up the profile?
77!     IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
78!     IF(lwp) REWIND( numstp )                       !  --------------------------
79
80      !                                              !* Test maximum of velocity (zonal only)
81      !                                              !  ------------------------
82      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
83      zumax = 0.e0
84#if defined key_z_first
85      DO jj = 1, jpj
86         DO ji = 1, jpi
87            DO jk = 1, jpk
88#else
89      DO jk = 1, jpk
90         DO jj = 1, jpj
91            DO ji = 1, jpi
92#endif
93               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
94          END DO
95        END DO
96      END DO       
97      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
98      !
99      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
100      !
101      IF( zumax > 20.e0 ) THEN
102         IF( lk_mpp ) THEN
103            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
104         ELSE
105            ilocu = MAXLOC( ABS( un(:,:,:) ) )
106            ii = ilocu(1) + nimpp - 1
107            ij = ilocu(2) + njmpp - 1
108            ik = ilocu(3)
109         ENDIF
110         IF(lwp) THEN
111            WRITE(numout,cform_err)
112            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
113            WRITE(numout,*) ' ====== '
114            WRITE(numout,9400) kt, zumax, ii, ij, ik
115            WRITE(numout,*)
116            WRITE(numout,*) '          output of last fields in numwso'
117         ENDIF
118         kindic = -3
119      ENDIF
1209400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
121
122      !                                              !* Test minimum of salinity
123      !                                              !  ------------------------
124      !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
125      zsmin = 100.e0
126      DO jj = 2, jpjm1
127         DO ji = 1, jpi
128#if defined key_z_first
129            IF( tmask_1(ji,jj) == 1)  zsmin = MIN(zsmin,sn(ji,jj,1))
130#else
131            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1))
132#endif
133         END DO
134      END DO
135      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
136      !
137      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
138      !
139      IF( zsmin < 0.) THEN
140         IF (lk_mpp) THEN
141#if defined key_z_first
142            CALL mpp_minloc ( sn(:,:,1),tmask_1(:,:), zsmin, ii,ij )
143#else
144            CALL mpp_minloc ( sn(:,:,1),tmask(:,:,1), zsmin, ii,ij )
145#endif
146         ELSE
147#if defined key_z_first
148            ilocs = MINLOC( sn(:,:,1), mask = tmask_1(:,:) == 1.e0 )
149#else
150            ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )
151#endif
152            ii = ilocs(1) + nimpp - 1
153            ij = ilocs(2) + njmpp - 1
154         ENDIF
155         !
156         IF(lwp) THEN
157            WRITE(numout,cform_err)
158            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
159            WRITE(numout,*) '======= '
160            WRITE(numout,9500) kt, zsmin, ii, ij
161            WRITE(numout,*)
162            WRITE(numout,*) '          output of last fields in numwso'
163         ENDIF
164         kindic = -3
165      ENDIF
1669500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
167
168     
169      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
170
171      ! log file (solver or ssh statistics)
172      ! --------
173      IF( lk_dynspg_flt ) THEN      ! elliptic solver statistics (if required)
174         !
175         IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps       ! Solver
176         !
177         IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN   ! create a abort file if problem found
178            IF(lwp) THEN
179               WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
180               WRITE(numout,*) ' ====== '
181               WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
182               WRITE(numout,*)
183               WRITE(numout,*) ' stpctl: output of last fields'
184               WRITE(numout,*) ' ======  '
185            ENDIF
186         ENDIF
187         !
188      ELSE                                   !* ssh statistics (and others...)
189         IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
190            CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
191         ENDIF
192         !
193         !WRITE(*,*) narea,': ARPDBG: calc zssh2, step=',kt
194         !zssh2 = SUM( sshn(:,:) )
195         !WRITE(*,*) narea,': ARPDBG: sum of sshn = ',zssh2,' at step=',kt
196         zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
197         !WRITE(*,*) narea,': ARPDBG: mpp_sum for zssh2 (',zssh2,'), step=',kt
198         IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
199         !
200         IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
201         !
202      ENDIF
203
204      !WRITE(*,*) narea,': ARPDBG: stp_ctl end, step=',kt
205
2069200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 )
2079300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10)
208      !
209   END SUBROUTINE stp_ctl
210
211   !!======================================================================
212END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.