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

source: trunk/NEMO/OPA_SRC/stpctl.F90 @ 703

Last change on this file since 703 was 699, checked in by smasson, 16 years ago

insert revision Id

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 7.2 KB
Line 
1MODULE stpctl
2   !!==============================================================================
3   !!                       ***  MODULE  stpctl  ***
4   !! Ocean run control :  gross check of the ocean time stepping
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   stp_ctl      : Control the run
9   !!----------------------------------------------------------------------
10   !! * Modules used
11   USE oce             ! ocean dynamics and tracers variables
12   USE dom_oce         ! ocean space and time domain variables
13   USE sol_oce         ! ocean space and time domain variables
14   USE in_out_manager  ! I/O manager
15   USE solisl          ! ???
16   USE diawri          ! ocean output file
17   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
18   USE lib_mpp         ! distributed memory computing
19   USE dynspg_oce      ! pressure gradient schemes
20
21   IMPLICIT NONE
22   PRIVATE
23
24   !! * Accessibility
25   PUBLIC stp_ctl           ! routine called by step.F90
26   !!----------------------------------------------------------------------
27
28CONTAINS
29
30   SUBROUTINE stp_ctl( kt, kindic )
31      !!----------------------------------------------------------------------
32      !!                    ***  ROUTINE stp_ctl  ***
33      !!                     
34      !! ** Purpose :   Control the run
35      !!
36      !! ** Method  : - Save the time step in numstp
37      !!              - Print it each 50 time steps
38      !!              - Print solver statistics in numsol
39      !!              - Stop the run IF problem for the solver ( indec < 0 )
40      !!
41      !! History :
42      !!        !  91-03  ()
43      !!        !  91-11  (G. Madec)
44      !!        !  92-06  (M. Imbard)
45      !!        !  97-06  (A.M. Treguier)
46      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
47      !!----------------------------------------------------------------------
48      !! * Arguments
49      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
50      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
51
52      !! * local declarations
53      INTEGER  ::   ji, jj, jk              ! dummy loop indices
54      INTEGER  ::   ii, ij, ik              ! temporary integers
55      REAL(wp) ::   zumax, zsmin            ! temporary scalars
56      INTEGER, DIMENSION(3) ::   ilocu      !
57      INTEGER, DIMENSION(2) ::   ilocs      !
58      CHARACTER(len=80) :: clname
59      !!----------------------------------------------------------------------
60      !!  OPA 9.0 , LOCEAN-IPSL (2005)
61      !! $Id$
62      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
63      !!----------------------------------------------------------------------
64
65      IF( kt == nit000 .AND. lwp ) THEN
66         WRITE(numout,*)
67         WRITE(numout,*) 'stp_ctl : time-stepping control'
68         WRITE(numout,*) '~~~~~~~'
69         ! open time.step file
70         clname = 'time.step'
71         CALL ctlopn( numstp, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
72      ENDIF
73
74      ! save the current time step in numstp
75      ! ------------------------------------
76      IF(lwp) WRITE(numstp,9100) kt
77      IF(lwp) REWIND(numstp)
789100  FORMAT(1x, i8)
79
80
81      ! elliptic solver statistics (if required)
82      ! --------------------------
83      IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN
84      ! Solver
85      IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps
86
87      ! Islands (if exist)
88      IF( lk_isl )   CALL isl_stp_ctl( kt, kindic )
89
90
91      ! Output in numwso and numwvo IF kindic<0
92      ! ---------------------------------------
93      !    (i.e. problem for the solver)
94      IF( kindic < 0 ) THEN
95         IF(lwp) THEN
96            WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
97            WRITE(numout,*) ' ====== '
98            WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
99            WRITE(numout,*)
100            WRITE(numout,*) ' stpctl: output of last fields in numwso'
101            WRITE(numout,*) '                                  numwvo'
102            WRITE(numout,*) ' ======  *******************************'
103         ENDIF
104         CALL dia_wri( kt, kindic )
105      ENDIF
106      ENDIF
107
1089200  FORMAT(' it :', i8, ' niter :', i4, ' res :',e20.10,' b :',e20.10)
109
110      ! Test maximum of velocity (zonal only)
111      ! ------------------------
112      !! zumax = MAXVAL( ABS( un(:,:,:) ) )   ! slower than the following loop on NEC SX5
113      zumax = 0.e0
114      DO jk = 1, jpk
115         DO jj = 1, jpj
116            DO ji = 1, jpi
117               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
118          END DO
119        END DO
120      END DO       
121      IF( lk_mpp )   CALL mpp_max( zumax )   ! max over the global domain
122
123      IF( MOD( kt, nwrite ) == 1 ) THEN
124         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
125      ENDIF
126      IF( zumax > 20.) THEN
127         IF( lk_mpp ) THEN
128            CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik)
129         ELSE
130            ilocu = MAXLOC( ABS( un(:,:,:) ) )
131            ii = ilocu(1) + nimpp - 1
132            ij = ilocu(2) + njmpp - 1
133            ik = ilocu(3)
134         ENDIF
135         IF(lwp) THEN
136            WRITE(numout,cform_err)
137            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
138            WRITE(numout,*) ' ====== '
139            WRITE(numout,9400) kt, zumax, ii, ij, ik
140            WRITE(numout,*)
141            WRITE(numout,*) '          output of last fields in numwso'
142         ENDIF
143         kindic  = -3
144
145         CALL dia_wri( kt, kindic )
146      ENDIF
1479400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i4)
148
149
150      ! Test minimum of salinity
151      ! ------------------------
152      !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )   
153      !                slower than the following loop on NEC SX5
154      zsmin = 100.e0
155      DO jj = 2, jpjm1
156         DO ji = 1, jpi
157            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1))
158         END DO
159      END DO
160      IF( lk_mpp )   CALL mpp_min( zsmin )   ! min over the global domain
161
162      IF( MOD( kt, nwrite ) == 1 ) THEN
163         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
164      ENDIF
165      IF( zsmin < 0.) THEN
166         IF (lk_mpp) THEN
167            CALL mpp_minloc ( sn(:,:,1),tmask(:,:,1), zsmin, ii,ij )
168         ELSE
169            ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )
170            ii = ilocs(1) + nimpp - 1
171            ij = ilocs(2) + njmpp - 1
172         END IF
173
174         IF(lwp) THEN
175            WRITE(numout,cform_err)
176            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
177            WRITE(numout,*) '======= '
178            WRITE(numout,9500) kt, zsmin, ii, ij
179            WRITE(numout,*)
180            WRITE(numout,*) '          output of last fields in numwso'
181         ENDIF
182         IF( kindic < 0 ) THEN
183            IF(lwp) WRITE(numout,*) ' stpctl diabort done. We wont do it again '
184         ELSE
185            kindic  = -3
186            CALL dia_wri(kt,kindic)
187         ENDIF
188      ENDIF
1899500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i4)
190
191   END SUBROUTINE stp_ctl
192
193   !!======================================================================
194END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.