Changeset 14318 for NEMO/trunk/src/SAS

Timestamp:

2021-01-20T11:49:35+01:00 (3 years ago)

Author:

smasson

Message:

trunk: stpctl cleaning, #2602

File:

• NEMO/trunk/src/SAS/stpctl.F90 (modified) (12 diffs)

NEMO/trunk/src/SAS/stpctl.F90

@@ -34 +34 @@
    PUBLIC stp_ctl           ! routine called by step.F90
 
-   INTEGER                ::   nrunid   ! netcdf file id
-   INTEGER, DIMENSION(3)  ::   nvarid   ! netcdf variable id
+   INTEGER, PARAMETER         ::   jpvar = 3
+   INTEGER                    ::   nrunid   ! netcdf file id
+   INTEGER, DIMENSION(jpvar)  ::   nvarid   ! netcdf variable id
    !!----------------------------------------------------------------------
    !! NEMO/SAS 4.0 , NEMO Consortium (2018)
@@ -46 +47 @@
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE stp_ctl  ***
-      !!                     
+      !!
       !! ** Purpose :   Control the run
       !!
@@ -62 +63 @@
       INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index
       !!
+      INTEGER, PARAMETER              ::   jptst = 3
       INTEGER                         ::   ji                                    ! dummy loop indices
       INTEGER                         ::   idtime, istatus
-      INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax
-      INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices
+      INTEGER , DIMENSION(jptst)      ::   iareasum, iareamin, iareamax
+      INTEGER , DIMENSION(3,jptst)    ::   iloc                                  ! min/max loc indices
       REAL(wp)                        ::   zzz                                   ! local real 
-      REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal
+      REAL(wp), DIMENSION(jpvar+1)    ::   zmax
+      REAL(wp), DIMENSION(jptst)      ::   zmaxlocal
       LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce
       LOGICAL, DIMENSION(jpi,jpj)     ::   llmsk
@@ -75 +78 @@
       !
       ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
-      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 
+      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1
       ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm
       !
@@ -107 +110 @@
             istatus = NF90_ENDDEF(nrunid)
          ENDIF
-         !    
+         !
       ENDIF
       !
@@ -131 +134 @@
       zmax(2) = MAXVAL( ABS( u_ice(:,:) )    , mask = llmsk )                   ! max ice velocity (zonal only)
       zmax(3) = MAXVAL(     -tm_i (:,:) + rt0, mask = llmsk )                   ! min ice temperature (in degC)
-      zmax(4) = REAL( nstop, wp )                                               ! stop indicator
+      zmax(jpvar+1) = REAL( nstop, wp )                                         ! stop indicator
       !
       !                                   !==               get global extrema             ==!
       !                                   !==  done by all processes if writting run.stat  ==!
       IF( ll_colruns ) THEN
-         zmaxlocal(:) = zmax(:)
+         zmaxlocal(:) = zmax(1:jptst)
          CALL mpp_max( "stpctl", zmax )          ! max over the global domain: ok even of ll_0oce = .true.
-         nstop = NINT( zmax(4) )                 ! update nstop indicator (now sheared among all local domains)
+         nstop = NINT( zmax(jpvar+1) )           ! update nstop indicator (now sheared among all local domains)
       ELSE
          ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow.
-         IF( ll_0oce )   zmax(1:3) = 0._wp       ! default "valid" values...
+         IF( ll_0oce )   zmax(1:jptst) = 0._wp        ! default "valid" values...
       ENDIF
       !
@@ -150 +153 @@
       !                                   !==  done only by 1st subdomain at writting timestep  ==!
       IF( ll_wrtruns ) THEN
-         WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3)
-         DO ji = 1, 3
+         WRITE(numrun,9500) kt, zmax(1:jptst)
+         DO ji = 1, jpvar
             istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) )
          END DO
@@ -159 +162 @@
       !                                   !==  done by all processes at every time step  ==!
       !
-      IF(   zmax(1) >  100._wp .OR.   &                   ! too large ice thickness maximum ( > 100 m)
-         &  zmax(2) >   10._wp .OR.   &                   ! too large ice velocity ( > 10 m/s)
-         &  zmax(3) < -101._wp .OR.   &                   ! too cold ice temperature ( < -100 degC)
-         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests
-         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests
+      IF(   zmax(1) >  100._wp .OR.   &                       ! too large ice thickness maximum ( > 100 m)
+         &  zmax(2) >   10._wp .OR.   &                       ! too large ice velocity ( > 10 m/s)
+         &  zmax(3) < -101._wp .OR.   &                       ! too cold ice temperature ( < -100 degC)
+         & ISNAN( SUM(zmax(1:jptst)) ) .OR.   &               ! NaN encounter in the tests
+         & ABS(   SUM(zmax(1:jptst)) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests
          !
          iloc(:,:) = 0
@@ -175 +178 @@
             ! find which subdomain has the max.
             iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0
-            DO ji = 1, 4
+            DO ji = 1, jptst
                IF( zmaxlocal(ji) == zmax(ji) ) THEN
                   iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1
@@ -188 +191 @@
             iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) )    , mask = llmsk )
             iloc(1:2,3) = MINLOC(       tm_i(:,:) - rt0, mask = llmsk )
-            DO ji = 1, 3   ! local domain indices ==> global domain indices, excluding halos
+            DO ji = 1, jptst   ! local domain indices ==> global domain indices, excluding halos
                iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
             END DO
@@ -206 +209 @@
          CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file
          !
-         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files
+         IF( ll_colruns .OR. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files
             IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 )
             ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop)
@@ -247 +250 @@
       !!----------------------------------------------------------------------
       WRITE(clkt , '(i9)') kt
-      
+
       WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9)
       !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF