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

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.0 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      !!----------------------------------------------------------------------
58      !!  OPA 9.0 , LOCEAN-IPSL (2005)
59      !! $Header$
60      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
61      !!----------------------------------------------------------------------
62
63      IF( kt == nit000 .AND. lwp ) THEN
64         WRITE(numout,*)
65         WRITE(numout,*) 'stp_ctl : time-stepping control'
66         WRITE(numout,*) '~~~~~~~'
67         ! open time.step file
68         CALL ctlopn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
69      ENDIF
70
71      ! save the current time step in numstp
72      ! ------------------------------------
73      IF(lwp) WRITE(numstp,9100) kt
74      IF(lwp) REWIND(numstp)
759100  FORMAT(1x, i8)
76
77
78      ! elliptic solver statistics
79      ! -----------------------------
80      ! Solver
81      IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps
829200  FORMAT(' it :', i8, ' niter :', i4, ' res :',e20.10,' b :',e20.10)
83
84      ! Islands (if exist)
85      IF( lk_isl )   CALL isl_stp_ctl( kt, kindic )
86
87
88      ! Output in numwso and numwvo IF kindic<0
89      ! ---------------------------------------
90      !    (i.e. problem for the solver)
91      IF( kindic < 0 ) THEN
92         IF(lwp) THEN
93            WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
94            WRITE(numout,*) ' ====== '
95            WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
96            WRITE(numout,*)
97            WRITE(numout,*) ' stpctl: output of last fields in numwso'
98            WRITE(numout,*) '                                  numwvo'
99            WRITE(numout,*) ' ======  *******************************'
100         ENDIF
101         CALL dia_wri( kt, kindic )
102      ENDIF
103
104      ! Test maximum of velocity (zonal only)
105      ! ------------------------
106      !! zumax = MAXVAL( ABS( un(:,:,:) ) )   ! slower than the following loop on NEC SX5
107      zumax = 0.e0
108      DO jk = 1, jpk
109         DO jj = 1, jpj
110            DO ji = 1, jpi
111               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
112          END DO
113        END DO
114      END DO       
115      IF( lk_mpp )   CALL mpp_max( zumax )   ! max over the global domain
116
117      IF( MOD( kt, nwrite ) == 1 ) THEN
118         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
119      ENDIF
120      IF( zumax >  20.) THEN
121         IF (lk_mpp ) THEN
122            CALL mpp_maxloc(un,umask,zumax,ii,ij,ik)
123         ELSE
124           ilocu = MAXLOC( ABS( un(:,:,:) ) )
125           ii = ilocu(1) + nimpp - 1
126           ij = ilocu(2) + njmpp - 1
127           ik = ilocu(3)
128         ENDIF
129         IF(lwp) THEN
130            WRITE(numout,cform_err)
131            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
132            WRITE(numout,*) ' ====== '
133            WRITE(numout,9400) kt, zumax, ii, ij, ik
134            WRITE(numout,*)
135            WRITE(numout,*) '          output of last fields in numwso'
136         ENDIF
137         kindic  = -3
138         CALL dia_wri( kt, kindic )
139      ENDIF
1409400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i4)
141
142
143      ! Test minimum of salinity
144      ! ------------------------
145      !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )   
146      !                slower than the following loop on NEC SX5
147      zsmin = 100.e0
148      DO jj = 2, jpjm1
149         DO ji = 1, jpi
150            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1))
151         END DO
152      END DO
153      IF( lk_mpp )   CALL mpp_min( zsmin )   ! min over the global domain
154
155      IF( MOD( kt, nwrite ) == 1 ) THEN
156         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
157      ENDIF
158      IF( zsmin < 0.) THEN
159         IF (lk_mpp) THEN
160            CALL mpp_minloc ( sn(:,:,1),tmask(:,:,1), zsmin, ii,ij )
161         ELSE
162            ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )
163            ii = ilocs(1) + nimpp - 1
164            ij = ilocs(2) + njmpp - 1
165         END IF
166
167         IF(lwp) THEN
168            WRITE(numout,cform_err)
169            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
170            WRITE(numout,*) '======= '
171            WRITE(numout,9500) kt, zsmin, ii, ij
172            WRITE(numout,*)
173            WRITE(numout,*) '          output of last fields in numwso'
174         ENDIF
175         IF( kindic < 0 ) THEN
176            IF(lwp) WRITE(numout,*) ' stpctl diabort done. We wont do it again '
177         ELSE
178            kindic  = -3
179            CALL dia_wri(kt,kindic)
180         ENDIF
181      ENDIF
1829500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i4)
183
184   END SUBROUTINE stp_ctl
185
186   !!======================================================================
187END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.