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

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

CT : UPDATE126 : improve MPI send possiblities with mpi_bsen and mpi_isend; update the search of extremum of scale factors in mpp
  • 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      !!----------------------------------------------------------------------
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         IF (lk_mpp ) THEN
120            CALL mpp_maxloc(un,umask,zumax,ii,ij,ik)
121         ELSE
122           ilocu = MAXLOC( ABS( un(:,:,:) ) )
123           ii = ilocu(1) + nimpp - 1
124           ij = ilocu(2) + njmpp - 1
125           ik = ilocu(3)
126         ENDIF
127         IF(lwp) THEN
128            WRITE(numout,cform_err)
129            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
130            WRITE(numout,*) ' ====== '
131            WRITE(numout,9400) kt, zumax, ii, ij, ik
132            WRITE(numout,*)
133            WRITE(numout,*) '          output of last fields in numwso'
134         ENDIF
135         kindic  = -3
136         CALL dia_wri( kt, kindic )
137      ENDIF
1389400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i4)
139
140
141      ! Test minimum of salinity
142      ! ------------------------
143      !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )   
144      !                slower than the following loop on NEC SX5
145      zsmin = 100.e0
146      DO jj = 2, jpjm1
147         DO ji = 1, jpi
148            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1))
149         END DO
150      END DO
151      IF( lk_mpp )   CALL mpp_min( zsmin )   ! min over the global domain
152
153      IF( MOD( kt, nwrite ) == 1 ) THEN
154         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
155      ENDIF
156      IF( zsmin < 0.) THEN
157         IF (lk_mpp) THEN
158            CALL mpp_minloc ( sn(:,:,1),tmask(:,:,1), zsmin, ii,ij )
159         ELSE
160            ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )
161            ii = ilocs(1) + nimpp - 1
162            ij = ilocs(2) + njmpp - 1
163         END IF
164
165         IF(lwp) THEN
166            WRITE(numout,cform_err)
167            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
168            WRITE(numout,*) '======= '
169            WRITE(numout,9500) kt, zsmin, ii, ij
170            WRITE(numout,*)
171            WRITE(numout,*) '          output of last fields in numwso'
172         ENDIF
173         IF( kindic < 0 ) THEN
174            IF(lwp) WRITE(numout,*) ' stpctl diabort done. We wont do it again '
175         ELSE
176            kindic  = -3
177            CALL dia_wri(kt,kindic)
178         ENDIF
179      ENDIF
1809500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i4)
181
182   END SUBROUTINE stp_ctl
183
184   !!======================================================================
185END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.