source: NEMO/trunk/src/OCE/stpctl.F90 @ 10570

Last change on this file since 10570 was 10570, checked in by acc, 19 months ago

Trunk update to implement finer control over the choice of text report files generated. See ticket: #2167

  • Property svn:keywords set to Id
File size: 11.3 KB
Line 
1MODULE stpctl
2   !!======================================================================
3   !!                       ***  MODULE  stpctl  ***
4   !! Ocean run control :  gross check of the ocean time stepping
5   !!======================================================================
6   !! History :  OPA  ! 1991-03  (G. Madec) Original code
7   !!            6.0  ! 1992-06  (M. Imbard)
8   !!            8.0  ! 1997-06  (A.M. Treguier)
9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
10   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
11   !!            3.7  ! 2016-09  (G. Madec)  Remove solver
12   !!            4.0  ! 2017-04  (G. Madec)  regroup global communications
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   stp_ctl      : Control the run
17   !!----------------------------------------------------------------------
18   USE oce             ! ocean dynamics and tracers variables
19   USE dom_oce         ! ocean space and time domain variables
20   USE c1d             ! 1D vertical configuration
21   USE diawri          ! Standard run outputs       (dia_wri_state routine)
22   !
23   USE in_out_manager  ! I/O manager
24   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
25   USE lib_mpp         ! distributed memory computing
26   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables
27   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy
28
29   USE netcdf          ! NetCDF library
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC stp_ctl           ! routine called by step.F90
34
35   INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus
36   LOGICAL  ::   lsomeoce
37   !!----------------------------------------------------------------------
38   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
39   !! $Id$
40   !! Software governed by the CeCILL license (see ./LICENSE)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE stp_ctl( kt, kindic )
45      !!----------------------------------------------------------------------
46      !!                    ***  ROUTINE stp_ctl  ***
47      !!                     
48      !! ** Purpose :   Control the run
49      !!
50      !! ** Method  : - Save the time step in numstp
51      !!              - Print it each 50 time steps
52      !!              - Stop the run IF problem encountered by setting indic=-3
53      !!                Problems checked: |ssh| maximum larger than 10 m
54      !!                                  |U|   maximum larger than 10 m/s
55      !!                                  negative sea surface salinity
56      !!
57      !! ** Actions :   "time.step" file = last ocean time-step
58      !!                "run.stat"  file = run statistics
59      !!                nstop indicator sheared among all local domain (lk_mpp=T)
60      !!----------------------------------------------------------------------
61      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
62      INTEGER, INTENT(inout) ::   kindic   ! error indicator
63      !!
64      INTEGER                ::   ji, jj, jk          ! dummy loop indices
65      INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices
66      INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices
67      REAL(wp)               ::   zzz                 ! local real
68      REAL(wp), DIMENSION(9) ::   zmax
69      LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns
70      CHARACTER(len=20) :: clname
71      !!----------------------------------------------------------------------
72      !
73      ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
74      ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat )
75      ll_wrtruns = ll_colruns .AND. lwm
76      IF( kt == nit000 .AND. lwp ) THEN
77         WRITE(numout,*)
78         WRITE(numout,*) 'stp_ctl : time-stepping control'
79         WRITE(numout,*) '~~~~~~~'
80         !                                ! open time.step file
81         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
82         !                                ! open run.stat file(s) at start whatever
83         !                                ! the value of sn_cfctl%ptimincr
84         IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN
85            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
86            clname = 'run.stat.nc'
87            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
88            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun )
89            istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime )
90            istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh )
91            istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu   )
92            istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1  )
93            istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2  )
94            istatus = NF90_DEF_VAR( idrun,       't_min', NF90_DOUBLE, (/ idtime /), idt1  )
95            istatus = NF90_DEF_VAR( idrun,       't_max', NF90_DOUBLE, (/ idtime /), idt2  )
96            IF( ln_zad_Aimp ) THEN
97               istatus = NF90_DEF_VAR( idrun,   'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1  )
98               istatus = NF90_DEF_VAR( idrun,       'Cu_max', NF90_DOUBLE, (/ idtime /), idc1  )
99            ENDIF
100            istatus = NF90_ENDDEF(idrun)
101            zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use
102         ENDIF
103      ENDIF
104      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0
105      !
106      IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file)
107         WRITE ( numstp, '(1x, i8)' )   kt
108         REWIND( numstp )
109      ENDIF
110      !
111      !                                   !==  test of extrema  ==!
112      IF( ll_wd ) THEN
113         zmax(1) = MAXVAL(  ABS( sshn(:,:) + ssh_ref*tmask(:,:,1) )  )        ! ssh max
114      ELSE
115         zmax(1) = MAXVAL(  ABS( sshn(:,:) )  )                               ! ssh max
116      ENDIF
117      zmax(2) = MAXVAL(  ABS( un(:,:,:) )  )                                  ! velocity max (zonal only)
118      zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max
119      zmax(4) = MAXVAL(  tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp )   !       salinity max
120      zmax(5) = MAXVAL( -tsn(:,:,:,jp_tem) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max
121      zmax(6) = MAXVAL(  tsn(:,:,:,jp_tem) , mask = tmask(:,:,:) == 1._wp )   !       temperature max
122      zmax(7) = REAL( nstop , wp )                                            ! stop indicator
123      IF( ln_zad_Aimp ) THEN
124         zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max
125         zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) !       cell Courant no. max
126      ENDIF
127      !
128      IF( ll_colruns ) THEN
129         CALL mpp_max( "stpctl", zmax )          ! max over the global domain
130         nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains
131      ENDIF
132      !                                   !==  run statistics  ==!   ("run.stat" files)
133      IF( ll_wrtruns ) THEN
134         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4)
135         istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) )
136         istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) )
137         istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) )
138         istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) )
139         istatus = NF90_PUT_VAR( idrun,  idt1, (/-zmax(5)/), (/kt/), (/1/) )
140         istatus = NF90_PUT_VAR( idrun,  idt2, (/ zmax(6)/), (/kt/), (/1/) )
141         IF( ln_zad_Aimp ) THEN
142            istatus = NF90_PUT_VAR( idrun,  idw1, (/ zmax(8)/), (/kt/), (/1/) )
143            istatus = NF90_PUT_VAR( idrun,  idc1, (/ zmax(9)/), (/kt/), (/1/) )
144         ENDIF
145         IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun)
146         IF( kt == nitend         ) istatus = NF90_CLOSE(idrun)
147      END IF
148      !                                   !==  error handling  ==!
149      IF( ( ln_ctl .OR. lsomeoce ) .AND. (   &             ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points
150         &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m )
151         &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s)
152         &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity
153         &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 )
154         &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice)
155         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests
156         IF( lk_mpp .AND. ln_ctl ) THEN
157            CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  )
158            CALL mpp_maxloc( 'stpctl', ABS(un)          , umask (:,:,:), zzz, iu  )
159            CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 )
160            CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 )
161         ELSE
162            ih(:)  = MAXLOC( ABS( sshn(:,:)   )                              ) + (/ nimpp - 1, njmpp - 1    /)
163            iu(:)  = MAXLOC( ABS( un  (:,:,:) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /)
164            is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
165            is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
166         ENDIF
167         
168         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests'
169         WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2)
170         WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3)
171         WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3)
172         WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3)
173         WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file'
174         
175         CALL dia_wri_state( 'output.abort' )     ! create an output.abort file
176         
177         IF( .NOT. ln_ctl ) THEN
178            WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea
179            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 )
180         ELSE
181            CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )
182         ENDIF
183
184         kindic = -3
185         !
186      ENDIF
187      !
1889100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5)
1899200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5)
1909300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5)
1919400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5)
1929500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16)
193      !
194   END SUBROUTINE stp_ctl
195
196   !!======================================================================
197END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.