Changeset 14318 for NEMO/trunk/tests


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

trunk: stpctl cleaning, #2602

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/tests/STATION_ASF/MY_SRC/stpctl.F90

    r14072 r14318  
    3131   PUBLIC stp_ctl           ! routine called by step.F90 
    3232 
    33    INTEGER                ::   nrunid   ! netcdf file id 
    34    INTEGER, DIMENSION(3)  ::   nvarid   ! netcdf variable id 
     33   INTEGER, PARAMETER         ::   jpvar = 3 
     34   INTEGER                    ::   nrunid   ! netcdf file id 
     35   INTEGER, DIMENSION(jpvar)  ::   nvarid   ! netcdf variable id 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    5960      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
    6061      !! 
     62      INTEGER, PARAMETER              ::   jptst = 3 
    6163      INTEGER                         ::   ji                                    ! dummy loop indices 
    6264      INTEGER                         ::   idtime, istatus 
    63       INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax 
    64       INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices 
    65       REAL(wp)                        ::   zzz                                   ! local real 
    66       REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal 
     65      INTEGER , DIMENSION(jptst)      ::   iareasum, iareamin, iareamax 
     66      INTEGER , DIMENSION(3,jptst)    ::   iloc                                  ! min/max loc indices 
     67      REAL(wp)                        ::   zzz                                   ! local real  
     68      REAL(wp), DIMENSION(jpvar+1)    ::   zmax 
     69      REAL(wp), DIMENSION(jptst)      ::   zmaxlocal 
    6770      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 
    6871      LOGICAL, DIMENSION(jpi,jpj)     ::   llmsk 
     
    122125      zmax(2) = MAXVAL( ABS( qns(:,:) ), mask = llmsk )                         ! max non-solar heat flux 
    123126      zmax(3) = MAXVAL( ABS( emp(:,:) ), mask = llmsk )                         ! max E-P 
    124       zmax(4) = REAL( nstop, wp )                                               ! stop indicator 
     127      zmax(jpvar+1) = REAL( nstop, wp )                                         ! stop indicator 
    125128      ! 
    126129      !                                   !==               get global extrema             ==! 
    127130      !                                   !==  done by all processes if writting run.stat  ==! 
    128131      IF( ll_colruns ) THEN 
    129          zmaxlocal(:) = zmax(:) 
    130          CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    131          nstop = NINT( zmax(4) )                 ! update nstop indicator (now sheared among all local domains) 
     132         zmaxlocal(:) = zmax(1:jptst) 
     133         CALL mpp_max( "stpctl", zmax )          ! max over the global domain: ok even of ll_0oce = .true. 
     134         nstop = NINT( zmax(jpvar+1) )           ! update nstop indicator (now sheared among all local domains) 
    132135      ELSE 
    133136         ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 
    134          IF( ll_0oce )   zmax(1:3) = 0._wp       ! default "valid" values... 
    135       ENDIF 
    136       !                                   !==               error handling               ==! 
     137         IF( ll_0oce )   zmax(1:jptst) = 0._wp        ! default "valid" values... 
     138      ENDIF 
    137139      !                                   !==              write "run.stat" files              ==! 
    138140      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    139141      IF( ll_wrtruns ) THEN 
    140          WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 
    141          DO ji = 1, 3 
     142         WRITE(numrun,9500) kt, zmax(1:jptst) 
     143         DO ji = 1, jpvar 
    142144            istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 
    143145         END DO 
    144          IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 
     146         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    145147      END IF 
    146148      !                                   !==               error handling               ==! 
    147149      !                                   !==  done by all processes at every time step  ==! 
    148150      ! 
    149       IF(   zmax(1) >    5._wp .OR.   &                   ! too large wind stress         ( > 5 N/m^2 ) 
    150          &  zmax(2) > 2000._wp .OR.   &                   ! too large non-solar heat flux ( > 2000 W/m^2 ) 
    151          &  zmax(3) > 1.E-3_wp .OR.   &                   ! too large net freshwater flux ( > 1.E-3 kg/m^2/s ) 
    152          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
    153          &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     151      IF(   zmax(1) >    5._wp .OR.   &                       ! too large wind stress         ( > 5 N/m^2 ) 
     152         &  zmax(2) > 2000._wp .OR.   &                       ! too large non-solar heat flux ( > 2000 W/m^2 ) 
     153         &  zmax(3) > 1.E-3_wp .OR.   &                       ! too large net freshwater flux ( > 1.E-3 kg/m^2/s ) 
     154         & ISNAN( SUM(zmax(1:jptst)) ) .OR.   &               ! NaN encounter in the tests 
     155         & ABS(   SUM(zmax(1:jptst)) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
    154156         ! 
    155157         iloc(:,:) = 0 
     
    163165            ! find which subdomain has the max. 
    164166            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
    165             DO ji = 1, 4 
     167            DO ji = 1, jptst 
    166168               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
    167169                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     
    176178            iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) 
    177179            iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) 
    178             DO ji = 1, 3   ! local domain indices ==> global domain indices, excluding halos 
     180            DO ji = 1, jptst   ! local domain indices ==> global domain indices, excluding halos 
    179181               iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 
    180182            END DO 
     
    195197         ! 
    196198         IF( ll_colruns .OR. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
    197             IF(lwp) THEN 
    198                CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
    199             ELSE 
    200                nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     199            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     200            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
    201201            ENDIF 
    202202         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     
    239239 
    240240      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
    241 !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     241      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
    242242      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
    243243      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
    244244      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
    245       WRITE(clmax, cl4) kmax-1 
     245                                   WRITE(clmax, cl4) kmax-1 
    246246      ! 
    247247      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     
    259259      ELSE 
    260260         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
    261 !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     261         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
    262262         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
    263263         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
Note: See TracChangeset for help on using the changeset viewer.