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

source: branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/stpctl.F90 @ 8865

Last change on this file since 8865 was 8865, checked in by deazer, 6 years ago

Moving Changes from CS15mini config into NEMO main src
Updating TEST configs to run wit this version of the code
all sette tests pass at this revision other than AGRIF
Includes updates to dynnxt and tranxt required for 3D rives in WAD case to be conservative.

Next commit will update naming conventions and tidy the code.

  • Property svn:keywords set to Id
File size: 8.1 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 c1d             ! 1D vertical configuration
19   !
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 lib_fortran     ! Fortran routines library
24   USE wet_dry,  ONLY: ln_wd, ln_rwd, rn_ssh_ref    ! reference depth for negative bathy
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC stp_ctl           ! routine called by step.F90
30   !!----------------------------------------------------------------------
31   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
32   !! $Id$
33   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35CONTAINS
36
37   SUBROUTINE stp_ctl( kt, kindic )
38      !!----------------------------------------------------------------------
39      !!                    ***  ROUTINE stp_ctl  ***
40      !!                     
41      !! ** Purpose :   Control the run
42      !!
43      !! ** Method  : - Save the time step in numstp
44      !!              - Print it each 50 time steps
45      !!              - Stop the run IF problem ( indic < 0 )
46      !!
47      !! ** Actions :   'time.step' file containing the last ocean time-step
48      !!               
49      !!----------------------------------------------------------------------
50      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
51      INTEGER, INTENT(inout) ::   kindic   ! error indicator
52      !!
53      INTEGER  ::   ji, jj, jk             ! dummy loop indices
54      INTEGER  ::   ii, ij, ik             ! local integers
55      REAL(wp) ::   zumax, zsmin, zssh2, zsshmax    ! local scalars
56      INTEGER, DIMENSION(3) ::   ilocu     !
57      INTEGER, DIMENSION(2) ::   ilocs     !
58      !!----------------------------------------------------------------------
59      !
60      IF( kt == nit000 .AND. lwp ) THEN
61         WRITE(numout,*)
62         WRITE(numout,*) 'stp_ctl : time-stepping control'
63         WRITE(numout,*) '~~~~~~~'
64         ! open time.step file
65         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
66      ENDIF
67      !
68      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
69      IF(lwp) REWIND( numstp )                       !  --------------------------
70      !
71      !                                              !* Test maximum of velocity (zonal only)
72      !                                              !  ------------------------
73      !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5
74      zumax = 0.e0
75      DO jk = 1, jpk
76         DO jj = 1, jpj
77            DO ji = 1, jpi
78               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
79          END DO
80        END DO
81      END DO       
82      IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain
83      !
84      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
85      !
86      IF( zumax > 20.e0 ) THEN
87         IF( lk_mpp ) THEN
88            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
89         ELSE
90            ilocu = MAXLOC( ABS( un(:,:,:) ) )
91            ii = ilocu(1) + nimpp - 1
92            ij = ilocu(2) + njmpp - 1
93            ik = ilocu(3)
94         ENDIF
95         IF(lwp) THEN
96            WRITE(numout,cform_err)
97            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
98            WRITE(numout,*) ' ====== '
99            WRITE(numout,9400) kt, zumax, ii, ij, ik
100            WRITE(numout,*)
101            WRITE(numout,*) '          output of last fields in numwso'
102         ENDIF
103         kindic = -3
104      ENDIF
1059400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
106      !
107      !                                              !* Test minimum of salinity
108      !                                              !  ------------------------
109      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5
110      zsmin = 100._wp
111      DO jj = 2, jpjm1
112         DO ji = 1, jpi
113            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal))
114         END DO
115      END DO
116      IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain
117      !
118      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
119      !
120      IF( zsmin < 0.) THEN
121         IF (lk_mpp) THEN
122            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij )
123         ELSE
124            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )
125            ii = ilocs(1) + nimpp - 1
126            ij = ilocs(2) + njmpp - 1
127         ENDIF
128         !
129         IF(lwp) THEN
130            WRITE(numout,cform_err)
131            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
132            WRITE(numout,*) '======= '
133            WRITE(numout,9500) kt, zsmin, ii, ij
134            WRITE(numout,*)
135            WRITE(numout,*) '          output of last fields in numwso'
136         ENDIF
137         kindic = -3
138      ENDIF
1399500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
140      !
141      !
142      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
143
144      ! log file (ssh statistics)
145      ! --------                                   !* ssh statistics (and others...)
146      IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file)
147         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
148      ENDIF
149      !
150      zsshmax = 0.e0
151      DO jj = 1, jpj
152         DO ji = 1, jpi
153            IF( (ln_wd .OR. ln_rwd)) THEN
154               IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)+rn_ssh_ref) )
155            ELSE
156               IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) )
157            ENDIF
158         END DO
159      END DO
160      IF( lk_mpp )   CALL mpp_max( zsshmax )                ! min over the global domain
161      !
162      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' ssh max:', zsshmax
163      !
164      IF( zsshmax > 10.e0 ) THEN
165         IF (lk_mpp) THEN
166            CALL mpp_maxloc( ABS(sshn(:,:)),tmask(:,:,1),zsshmax,ii,ij)
167         ELSE
168            ilocs = MAXLOC( ABS(sshn(:,:)) )
169            ii = ilocs(1) + nimpp - 1
170            ij = ilocs(2) + njmpp - 1
171         ENDIF
172         !
173         IF(lwp) THEN
174            WRITE(numout,cform_err)
175            WRITE(numout,*) 'stp_ctl : the ssh is larger than 10m'
176            WRITE(numout,*) '======= '
177            WRITE(numout,9600) kt, zsshmax, ii, ij
178            WRITE(numout,*)
179            WRITE(numout,*) '          output of last fields in numwso'
180         ENDIF
181         kindic = -3
182      ENDIF
1839600  FORMAT (' kt=',i6,' max ssh: ',1pg11.4,', i j: ',2i5)
184      !
185      zssh2 = glob_sum( sshn(:,:) * sshn(:,:) )
186      !
187      IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin      ! ssh statistics
188      !
1899700  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16)
190      !
191   END SUBROUTINE stp_ctl
192
193   !!======================================================================
194END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.