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

Last change on this file since 3187 was 3187, checked in by spickles2, 12 years ago

Stephen Pickles, 28 Nov 2011.
First commit of dCSE NEMO project work, part 1 - index re-ordering,
OPA_SRC top level only. Includes fix for sub-optimal auto-partitioning
in nemogcm.F90.
  • Property svn:keywords set to Id
File size: 8.3 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      IF( kt == nit000 .AND. lwp ) THEN
67         WRITE(numout,*)
68         WRITE(numout,*) 'stp_ctl : time-stepping control'
69         WRITE(numout,*) '~~~~~~~'
70         ! open time.step file
71         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
72      ENDIF
73
74!! DCSE_NEMO: commenting out these two lines. Do they mess up the profile?
75!     IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
76!     IF(lwp) REWIND( numstp )                       !  --------------------------
77
78      !                                              !* Test maximum of velocity (zonal only)
79      !                                              !  ------------------------
80      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
81      zumax = 0.e0
82#if defined key_z_first
83      DO jj = 1, jpj
84         DO ji = 1, jpi
85            DO jk = 1, jpk
86#else
87      DO jk = 1, jpk
88         DO jj = 1, jpj
89            DO ji = 1, jpi
90#endif
91               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
92          END DO
93        END DO
94      END DO       
95      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
96      !
97      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
98      !
99      IF( zumax > 20.e0 ) THEN
100         IF( lk_mpp ) THEN
101            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
102         ELSE
103            ilocu = MAXLOC( ABS( un(:,:,:) ) )
104            ii = ilocu(1) + nimpp - 1
105            ij = ilocu(2) + njmpp - 1
106            ik = ilocu(3)
107         ENDIF
108         IF(lwp) THEN
109            WRITE(numout,cform_err)
110            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
111            WRITE(numout,*) ' ====== '
112            WRITE(numout,9400) kt, zumax, ii, ij, ik
113            WRITE(numout,*)
114            WRITE(numout,*) '          output of last fields in numwso'
115         ENDIF
116         kindic = -3
117      ENDIF
1189400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
119
120      !                                              !* Test minimum of salinity
121      !                                              !  ------------------------
122      !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
123      zsmin = 100.e0
124      DO jj = 2, jpjm1
125         DO ji = 1, jpi
126#if defined key_z_first
127            IF( tmask_1(ji,jj) == 1)  zsmin = MIN(zsmin,sn(ji,jj,1))
128#else
129            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1))
130#endif
131         END DO
132      END DO
133      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
134      !
135      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
136      !
137      IF( zsmin < 0.) THEN
138         IF (lk_mpp) THEN
139#if defined key_z_first
140            CALL mpp_minloc ( sn(:,:,1),tmask_1(:,:), zsmin, ii,ij )
141#else
142            CALL mpp_minloc ( sn(:,:,1),tmask(:,:,1), zsmin, ii,ij )
143#endif
144         ELSE
145#if defined key_z_first
146            ilocs = MINLOC( sn(:,:,1), mask = tmask_1(:,:) == 1.e0 )
147#else
148            ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )
149#endif
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      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
168
169      ! log file (solver or ssh statistics)
170      ! --------
171      IF( lk_dynspg_flt ) THEN      ! elliptic solver statistics (if required)
172         !
173         IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps       ! Solver
174         !
175         IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN   ! create a abort file if problem found
176            IF(lwp) THEN
177               WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
178               WRITE(numout,*) ' ====== '
179               WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
180               WRITE(numout,*)
181               WRITE(numout,*) ' stpctl: output of last fields'
182               WRITE(numout,*) ' ======  '
183            ENDIF
184         ENDIF
185         !
186      ELSE                                   !* ssh statistics (and others...)
187         IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
188            CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
189         ENDIF
190         !
191         zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) )
192         IF( lk_mpp )   CALL mpp_sum( zssh2 )      ! sum over the global domain
193         !
194         IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin      ! ssh statistics
195         !
196      ENDIF
197
1989200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 )
1999300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10)
200      !
201   END SUBROUTINE stp_ctl
202
203   !!======================================================================
204END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.