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

source: tags/start/NEMO/OPA_SRC/stpctl.F90 @ 8420

Last change on this file since 8420 was 3, checked in by opalod, 20 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.9 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
20   IMPLICIT NONE
21   PRIVATE
22
23   !! * Accessibility
24   PUBLIC stp_ctl           ! routine called by step.F90
25   !!----------------------------------------------------------------------
26
27CONTAINS
28
29   SUBROUTINE stp_ctl( kt, kindic )
30      !!----------------------------------------------------------------------
31      !!                    ***  ROUTINE stp_ctl  ***
32      !!                     
33      !! ** Purpose :   Control the run
34      !!
35      !! ** Method  : - Save the time step in numstp
36      !!              - Print it each 50 time steps
37      !!              - Print solver statistics in numsol
38      !!              - Stop the run IF problem for the solver ( indec < 0 )
39      !!
40      !! History :
41      !!        !  91-03  ()
42      !!        !  91-11  (G. Madec)
43      !!        !  92-06  (M. Imbard)
44      !!        !  97-06  (A.M. Treguier)
45      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
46      !!----------------------------------------------------------------------
47      !! * Arguments
48      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
49      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
50
51      !! * local declarations
52      INTEGER  ::   ji, jj, jk              ! dummy loop indices
53      INTEGER  ::   ii, ij, ik              ! temporary integers
54      REAL(wp) ::   zumax, zsmin            ! temporary scalars
55      INTEGER, DIMENSION(3) ::   ilocu      !
56      INTEGER, DIMENSION(2) ::   ilocs      !
57#if defined key_dynspg_rl
58      INTEGER  ::   jni                     ! dummy loop indice
59      REAL(wp) ::   zfact                   ! temporary scalar
60#endif
61      !!----------------------------------------------------------------------
62      !!  OPA 8.5, LODYC-IPSL (2002)
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         CALL ctlopn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
71      ENDIF
72
73      ! save the current time step in numstp
74      ! ------------------------------------
75      IF(lwp) WRITE(numstp,9100) kt
76      IF(lwp) REWIND(numstp)
779100  FORMAT(1x, i8)
78
79
80      ! elliptic solver statistics
81      ! -----------------------------
82      ! Solver
83      IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps
849200  FORMAT(' it :', i8, ' niter :', i4, ' res :',e20.10,' b :',e20.10)
85
86      ! Islands (if exist)
87      IF( l_isl )   CALL isl_stp_ctl( kt, kindic )
88
89
90      ! Output in numwso and numwvo IF kindic<0
91      ! ---------------------------------------
92      !    (i.e. problem for the solver)
93      IF( kindic < 0 ) THEN
94         IF(lwp) THEN
95            WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
96            WRITE(numout,*) ' ====== '
97            WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
98            WRITE(numout,*)
99            WRITE(numout,*) ' stpctl: output of last fields in numwso'
100            WRITE(numout,*) '                                  numwvo'
101            WRITE(numout,*) ' ======  *******************************'
102         ENDIF
103         CALL dia_wri( kt, kindic )
104      ENDIF
105
106      ! Test maximum of velocity (zonal only)
107      ! ------------------------
108      !! zumax = MAXVAL( ABS( un(:,:,:) ) )   ! slower than the following loop on NEC SX5
109      zumax = 0.0
110      DO jk = 1, jpk
111         DO jj = 1, jpj
112            DO ji = 1, jpi
113               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
114          END DO
115        END DO
116      END DO       
117#if defined key_mpp   
118      CALL mpp_max( zumax )
119#endif
120      IF( MOD( kt, nwrite ) == 1 ) THEN
121         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
122      ENDIF
123      IF( zumax >  20.) THEN
124         ilocu = MAXLOC( ABS( un(:,:,:) ) )
125         ii = ilocu(1) + nimpp - 1
126         ij = ilocu(2) + njmpp - 1
127         ik = ilocu(3)
128#if defined key_mpp
129         CALL mpp_isl( ii )
130         CALL mpp_isl( ij )
131         CALL mpp_isl( ik )
132#endif
133         IF(lwp) THEN
134            WRITE(numout,cform_err)
135            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
136            WRITE(numout,*) ' ====== '
137            WRITE(numout,9400) kt, zumax, ii, ij, ik
138            WRITE(numout,*)
139            WRITE(numout,*) '          output of last fields in numwso'
140         ENDIF
141         kindic  = -3
142         CALL dia_wri( kt, kindic )
143      ENDIF
1449400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i4)
145
146
147      ! Test minimum of salinity
148      ! ------------------------
149      !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )   
150      !                slower than the following loop on NEC SX5
151      zsmin = 100.0
152      DO jj = 2, jpjm1
153         DO ji = 1, jpi
154            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1))
155         END DO
156      END DO
157#if defined key_mpp   
158      CALL mpp_min( zsmin )
159#endif
160      IF( MOD( kt, nwrite ) == 1 ) THEN
161         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
162      ENDIF
163      IF( zsmin < 0.) THEN
164         ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )
165         ii = ilocs(1) + nimpp - 1
166         ij = ilocs(2) + njmpp - 1
167#if defined key_mpp
168         CALL mpp_isl( ii )
169         CALL mpp_isl( ij )
170#endif
171         IF(lwp) THEN
172            WRITE(numout,cform_err)
173            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
174            WRITE(numout,*) '======= '
175            WRITE(numout,9500) kt, zsmin, ii, ij
176            WRITE(numout,*)
177            WRITE(numout,*) '          output of last fields in numwso'
178         ENDIF
179         IF( kindic < 0 ) THEN
180            IF(lwp) WRITE(numout,*) ' stpctl diabort done. We wont do it again '
181         ELSE
182            kindic  = -3
183            CALL dia_wri(kt,kindic)
184         ENDIF
185      ENDIF
1869500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i4)
187
188   END SUBROUTINE stp_ctl
189
190   !!======================================================================
191END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.