source: NEMO/trunk/tests/CANAL/MY_SRC/stpctl.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 10 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 11.4 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, Kbb, Kmm, 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(in   ) ::   Kbb, Kmm      ! ocean time level index
63      INTEGER, INTENT(inout) ::   kindic   ! error indicator
64      !!
65      INTEGER                ::   ji, jj, jk          ! dummy loop indices
66      INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices
67      INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices
68      REAL(wp)               ::   zzz                 ! local real
69      REAL(wp), DIMENSION(9) ::   zmax
70      LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns
71      CHARACTER(len=20) :: clname
72      !!----------------------------------------------------------------------
73      !
74      ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
75      ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat )
76      ll_wrtruns = ll_colruns .AND. lwm
77      IF( kt == nit000 .AND. lwp ) THEN
78         WRITE(numout,*)
79         WRITE(numout,*) 'stp_ctl : time-stepping control'
80         WRITE(numout,*) '~~~~~~~'
81         !                                ! open time.step file
82         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
83         !                                ! open run.stat file(s) at start whatever
84         !                                ! the value of sn_cfctl%ptimincr
85         IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN
86            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
87            clname = 'run.stat.nc'
88            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
89            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun )
90            istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime )
91            istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh )
92            istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu   )
93            istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1  )
94            istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2  )
95            istatus = NF90_DEF_VAR( idrun,       't_min', NF90_DOUBLE, (/ idtime /), idt1  )
96            istatus = NF90_DEF_VAR( idrun,       't_max', NF90_DOUBLE, (/ idtime /), idt2  )
97            IF( ln_zad_Aimp ) THEN
98               istatus = NF90_DEF_VAR( idrun,   'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1  )
99               istatus = NF90_DEF_VAR( idrun,       'Cu_max', NF90_DOUBLE, (/ idtime /), idc1  )
100            ENDIF
101            istatus = NF90_ENDDEF(idrun)
102            zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use
103         ENDIF
104      ENDIF
105      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0
106      !
107      IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file)
108         WRITE ( numstp, '(1x, i8)' )   kt
109         REWIND( numstp )
110      ENDIF
111      !
112      !                                   !==  test of extrema  ==!
113      IF( ll_wd ) THEN
114         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max
115      ELSE
116         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max
117      ENDIF
118      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only)
119      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max
120      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       salinity max
121      zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max
122      zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       temperature max
123      zmax(7) = REAL( nstop , wp )                                            ! stop indicator
124      IF( ln_zad_Aimp ) THEN
125         zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max
126         zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) !       cell Courant no. max
127      ENDIF
128      !
129      IF( ll_colruns ) THEN
130         CALL mpp_max( "stpctl", zmax )          ! max over the global domain
131         nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains
132      ENDIF
133      !                                   !==  run statistics  ==!   ("run.stat" files)
134      IF( ll_wrtruns ) THEN
135         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4)
136         istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) )
137         istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) )
138         istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) )
139         istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) )
140         istatus = NF90_PUT_VAR( idrun,  idt1, (/-zmax(5)/), (/kt/), (/1/) )
141         istatus = NF90_PUT_VAR( idrun,  idt2, (/ zmax(6)/), (/kt/), (/1/) )
142         IF( ln_zad_Aimp ) THEN
143            istatus = NF90_PUT_VAR( idrun,  idw1, (/ zmax(8)/), (/kt/), (/1/) )
144            istatus = NF90_PUT_VAR( idrun,  idc1, (/ zmax(9)/), (/kt/), (/1/) )
145         ENDIF
146         IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun)
147         IF( kt == nitend         ) istatus = NF90_CLOSE(idrun)
148      END IF
149      !                                   !==  error handling  ==!
150      IF( ( ln_ctl .OR. lsomeoce ) .AND. (   &             ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points
151         &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m )
152         &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s)
153!!$      &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity
154!!$      &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 )
155!!$      &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice)
156         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests
157         IF( lk_mpp .AND. ln_ctl ) THEN
158            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  )
159            CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  )
160            CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 )
161            CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 )
162         ELSE
163            ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /)
164            iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /)
165            is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
166            is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
167         ENDIF
168         
169         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests'
170         WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2)
171         WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3)
172         WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3)
173         WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3)
174         WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file'
175         
176         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file
177         
178         IF( .NOT. ln_ctl ) THEN
179            WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea
180            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 )
181         ELSE
182            CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )
183         ENDIF
184
185         kindic = -3
186         !
187      ENDIF
188      !
1899100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5)
1909200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5)
1919300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5)
1929400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5)
1939500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16)
194      !
195   END SUBROUTINE stp_ctl
196
197   !!======================================================================
198END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.