Ignore:
Timestamp:
2021-01-20T11:49:35+01:00 (3 months ago)
Author:
smasson
Message:

trunk: stpctl cleaning, #2602

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/SAS/stpctl.F90

    r13616 r14318  
    3434   PUBLIC stp_ctl           ! routine called by step.F90 
    3535 
    36    INTEGER                ::   nrunid   ! netcdf file id 
    37    INTEGER, DIMENSION(3)  ::   nvarid   ! netcdf variable id 
     36   INTEGER, PARAMETER         ::   jpvar = 3 
     37   INTEGER                    ::   nrunid   ! netcdf file id 
     38   INTEGER, DIMENSION(jpvar)  ::   nvarid   ! netcdf variable id 
    3839   !!---------------------------------------------------------------------- 
    3940   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    4647      !!---------------------------------------------------------------------- 
    4748      !!                    ***  ROUTINE stp_ctl  *** 
    48       !!                      
     49      !! 
    4950      !! ** Purpose :   Control the run 
    5051      !! 
     
    6263      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
    6364      !! 
     65      INTEGER, PARAMETER              ::   jptst = 3 
    6466      INTEGER                         ::   ji                                    ! dummy loop indices 
    6567      INTEGER                         ::   idtime, istatus 
    66       INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax 
    67       INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices 
     68      INTEGER , DIMENSION(jptst)      ::   iareasum, iareamin, iareamax 
     69      INTEGER , DIMENSION(3,jptst)    ::   iloc                                  ! min/max loc indices 
    6870      REAL(wp)                        ::   zzz                                   ! local real  
    69       REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal 
     71      REAL(wp), DIMENSION(jpvar+1)    ::   zmax 
     72      REAL(wp), DIMENSION(jptst)      ::   zmaxlocal 
    7073      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 
    7174      LOGICAL, DIMENSION(jpi,jpj)     ::   llmsk 
     
    7578      ! 
    7679      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    77       ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     80      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 
    7881      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
    7982      ! 
     
    107110            istatus = NF90_ENDDEF(nrunid) 
    108111         ENDIF 
    109          !     
     112         ! 
    110113      ENDIF 
    111114      ! 
     
    131134      zmax(2) = MAXVAL( ABS( u_ice(:,:) )    , mask = llmsk )                   ! max ice velocity (zonal only) 
    132135      zmax(3) = MAXVAL(     -tm_i (:,:) + rt0, mask = llmsk )                   ! min ice temperature (in degC) 
    133       zmax(4) = REAL( nstop, wp )                                               ! stop indicator 
     136      zmax(jpvar+1) = REAL( nstop, wp )                                         ! stop indicator 
    134137      ! 
    135138      !                                   !==               get global extrema             ==! 
    136139      !                                   !==  done by all processes if writting run.stat  ==! 
    137140      IF( ll_colruns ) THEN 
    138          zmaxlocal(:) = zmax(:) 
     141         zmaxlocal(:) = zmax(1:jptst) 
    139142         CALL mpp_max( "stpctl", zmax )          ! max over the global domain: ok even of ll_0oce = .true. 
    140          nstop = NINT( zmax(4) )                 ! update nstop indicator (now sheared among all local domains) 
     143         nstop = NINT( zmax(jpvar+1) )           ! update nstop indicator (now sheared among all local domains) 
    141144      ELSE 
    142145         ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 
    143          IF( ll_0oce )   zmax(1:3) = 0._wp       ! default "valid" values... 
     146         IF( ll_0oce )   zmax(1:jptst) = 0._wp        ! default "valid" values... 
    144147      ENDIF 
    145148      ! 
     
    150153      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    151154      IF( ll_wrtruns ) THEN 
    152          WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 
    153          DO ji = 1, 3 
     155         WRITE(numrun,9500) kt, zmax(1:jptst) 
     156         DO ji = 1, jpvar 
    154157            istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 
    155158         END DO 
     
    159162      !                                   !==  done by all processes at every time step  ==! 
    160163      ! 
    161       IF(   zmax(1) >  100._wp .OR.   &                   ! too large ice thickness maximum ( > 100 m) 
    162          &  zmax(2) >   10._wp .OR.   &                   ! too large ice velocity ( > 10 m/s) 
    163          &  zmax(3) < -101._wp .OR.   &                   ! too cold ice temperature ( < -100 degC) 
    164          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
    165          &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     164      IF(   zmax(1) >  100._wp .OR.   &                       ! too large ice thickness maximum ( > 100 m) 
     165         &  zmax(2) >   10._wp .OR.   &                       ! too large ice velocity ( > 10 m/s) 
     166         &  zmax(3) < -101._wp .OR.   &                       ! too cold ice temperature ( < -100 degC) 
     167         & ISNAN( SUM(zmax(1:jptst)) ) .OR.   &               ! NaN encounter in the tests 
     168         & ABS(   SUM(zmax(1:jptst)) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
    166169         ! 
    167170         iloc(:,:) = 0 
     
    175178            ! find which subdomain has the max. 
    176179            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
    177             DO ji = 1, 4 
     180            DO ji = 1, jptst 
    178181               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
    179182                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     
    188191            iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) )    , mask = llmsk ) 
    189192            iloc(1:2,3) = MINLOC(       tm_i(:,:) - rt0, mask = llmsk ) 
    190             DO ji = 1, 3   ! local domain indices ==> global domain indices, excluding halos 
     193            DO ji = 1, jptst   ! local domain indices ==> global domain indices, excluding halos 
    191194               iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
    192195            END DO 
     
    206209         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    207210         ! 
    208          IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     211         IF( ll_colruns .OR. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
    209212            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
    210213            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     
    247250      !!---------------------------------------------------------------------- 
    248251      WRITE(clkt , '(i9)') kt 
    249        
     252 
    250253      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
    251254      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
Note: See TracChangeset for help on using the changeset viewer.