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

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

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