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 NEMO/trunk/src/OCE – NEMO

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

Last change on this file since 12749 was 12377, checked in by acc, 4 years 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.5 KB
RevLine 
[3]1MODULE stpctl
[1489]2   !!======================================================================
[3]3   !!                       ***  MODULE  stpctl  ***
4   !! Ocean run control :  gross check of the ocean time stepping
[1489]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
[9019]11   !!            3.7  ! 2016-09  (G. Madec)  Remove solver
12   !!            4.0  ! 2017-04  (G. Madec)  regroup global communications
[1489]13   !!----------------------------------------------------------------------
[3]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
[6140]20   USE c1d             ! 1D vertical configuration
[9210]21   USE diawri          ! Standard run outputs       (dia_wri_state routine)
[6140]22   !
[3]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
[10364]26   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables
[9210]27   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy
[3]28
[9441]29   USE netcdf          ! NetCDF library
[3]30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC stp_ctl           ! routine called by step.F90
[9441]34
[10364]35   INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus
[10425]36   LOGICAL  ::   lsomeoce
[3]37   !!----------------------------------------------------------------------
[9598]38   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1489]39   !! $Id$
[10068]40   !! Software governed by the CeCILL license (see ./LICENSE)
[1489]41   !!----------------------------------------------------------------------
[3]42CONTAINS
43
[12377]44   SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic )
[3]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
[9019]52      !!              - Stop the run IF problem encountered by setting indic=-3
[10425]53      !!                Problems checked: |ssh| maximum larger than 10 m
[9019]54      !!                                  |U|   maximum larger than 10 m/s
55      !!                                  negative sea surface salinity
[3]56      !!
[9019]57      !! ** Actions :   "time.step" file = last ocean time-step
58      !!                "run.stat"  file = run statistics
[9210]59      !!                nstop indicator sheared among all local domain (lk_mpp=T)
[3]60      !!----------------------------------------------------------------------
[6140]61      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
[12377]62      INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index
[6140]63      INTEGER, INTENT(inout) ::   kindic   ! error indicator
[1489]64      !!
[10425]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
[10364]69      REAL(wp), DIMENSION(9) ::   zmax
[10570]70      LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns
[9565]71      CHARACTER(len=20) :: clname
[3]72      !!----------------------------------------------------------------------
[6140]73      !
[10570]74      ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
[12377]75      ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat )
[10570]76      ll_wrtruns = ll_colruns .AND. lwm
[3]77      IF( kt == nit000 .AND. lwp ) THEN
78         WRITE(numout,*)
79         WRITE(numout,*) 'stp_ctl : time-stepping control'
[79]80         WRITE(numout,*) '~~~~~~~'
[9019]81         !                                ! open time.step file
[10425]82         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
[10570]83         !                                ! open run.stat file(s) at start whatever
84         !                                ! the value of sn_cfctl%ptimincr
[12377]85         IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN
[10425]86            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
[9565]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 )
[9441]90            istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime )
91            istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh )
[9808]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  )
[10364]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  )
[11407]99               istatus = NF90_DEF_VAR( idrun,       'Cf_max', NF90_DOUBLE, (/ idtime /), idc1  )
[10364]100            ENDIF
[9441]101            istatus = NF90_ENDDEF(idrun)
[10425]102            zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use
[9441]103         ENDIF
[3]104      ENDIF
[10425]105      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0
[6140]106      !
[10570]107      IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file)
[9019]108         WRITE ( numstp, '(1x, i8)' )   kt
109         REWIND( numstp )
[3]110      ENDIF
[6140]111      !
[9019]112      !                                   !==  test of extrema  ==!
[9023]113      IF( ll_wd ) THEN
[12377]114         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max
[9023]115      ELSE
[12377]116         zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max
[9023]117      ENDIF
[12377]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
[10364]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
[11407]126         zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) ! partitioning coeff. max
[10364]127      ENDIF
[1489]128      !
[10570]129      IF( ll_colruns ) THEN
[10425]130         CALL mpp_max( "stpctl", zmax )          ! max over the global domain
[10364]131         nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains
[9210]132      ENDIF
[10425]133      !                                   !==  run statistics  ==!   ("run.stat" files)
[10570]134      IF( ll_wrtruns ) THEN
[10425]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  ==!
[12377]150      IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. (   &  ! domain contains some ocean points, check for sensible ranges
[10425]151         &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m )
[9808]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)
[10425]156         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests
[12377]157         IF( lk_mpp .AND. sn_cfctl%l_glochk ) THEN
158            ! have use mpp_max (because sn_cfctl%l_glochk=.T. and distributed)
159            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  )
160            CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  )
161            CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 )
162            CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 )
[7852]163         ELSE
[12377]164            ! find local min and max locations
165            ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /)
166            iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /)
167            is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
168            is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
[7852]169         ENDIF
[10425]170         
171         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests'
172         WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2)
173         WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3)
174         WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3)
175         WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3)
176         WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file'
177         
[12377]178         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file
[10425]179         
[12377]180         IF( .NOT. sn_cfctl%l_glochk ) THEN
[10425]181            WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea
182            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 )
183         ELSE
184            CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )
[7852]185         ENDIF
[10425]186
[7852]187         kindic = -3
[9210]188         !
[7852]189      ENDIF
[10425]190      !
[9019]1919100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5)
1929200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5)
[9808]1939300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5)
1949400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5)
1959500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16)
[7852]196      !
[3]197   END SUBROUTINE stp_ctl
198
199   !!======================================================================
200END MODULE stpctl
Note: See TracBrowser for help on using the repository browser.