Changeset 10572 for NEMO/trunk/tests/CANAL/MY_SRC/stpctl.F90

Timestamp:

2019-01-24T16:37:13+01:00 (5 years ago)

Author:

smasson

Message:

trunk: update tests with latest src

File:

• NEMO/trunk/tests/CANAL/MY_SRC/stpctl.F90 (modified) (6 diffs)

NEMO/trunk/tests/CANAL/MY_SRC/stpctl.F90

@@ -67 +67 @@
       REAL(wp)               ::   zzz                 ! local real 
       REAL(wp), DIMENSION(9) ::   zmax
+      LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns
       CHARACTER(len=20) :: clname
       !!----------------------------------------------------------------------
       !
+      ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )
+      ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat )
+      ll_wrtruns = ll_colruns .AND. lwm
       IF( kt == nit000 .AND. lwp ) THEN
          WRITE(numout,*)
@@ -76 +80 @@
          !                                ! open time.step file
          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-         !                                ! open run.stat file
-         IF( ln_ctl .AND. lwm ) THEN
+         !                                ! open run.stat file(s) at start whatever
+         !                                ! the value of sn_cfctl%ptimincr
+         IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN
             CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
             clname = 'run.stat.nc'
@@ -99 +104 @@
       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0
       !
-      IF(lwm) THEN                        !==  current time step  ==!   ("time.step" file)
+      IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file)
          WRITE ( numstp, '(1x, i8)' )   kt
          REWIND( numstp )
@@ -121 +126 @@
       ENDIF
       !
-      IF( lk_mpp .AND. ln_ctl ) THEN
+      IF( ll_colruns ) THEN
          CALL mpp_max( "stpctl", zmax )          ! max over the global domain
          nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains
       ENDIF
       !                                   !==  run statistics  ==!   ("run.stat" files)
-      IF( ln_ctl .AND. lwm ) THEN
+      IF( ll_wrtruns ) THEN
          WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4)
          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) )
@@ -145 +150 @@
          &  zmax(1) >   50._wp .OR.   &                    ! too large sea surface height ( > 50 m )
          &  zmax(2) >   20._wp .OR.   &                    ! too large velocity ( > 20 m/s)
-         &  zmax(3) >= 100._wp .OR.   &                    ! too small sea surface salinity ( < -100 )
-         &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 )
-         &  zmax(4) < -100._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice)
-         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN  ! NaN encounter in the tests
+!!$         &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity
+!!$         &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 )
+!!$         &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice)
+         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests
          IF( lk_mpp .AND. ln_ctl ) THEN
             CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  )
@@ -160 +165 @@
             is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)
          ENDIF
-         IF( numout == 6 )   &   ! force to open ocean.output file
-            CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
-
-         WRITE(numout,cform_err)
-         WRITE(numout,*) ' stp_ctl: |ssh| > 50 m  or  |U| > 20 m/s  or  S <= -100  or  S >= 100  or  NaN encounter in the tests'
-         WRITE(numout,*) ' ======= '
-         IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea
-         WRITE(numout,9100) kt,   zmax(1), ih(1) , ih(2)
-         WRITE(numout,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3)
-         WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3)
-         WRITE(numout,9400) kt,   zmax(4), is2(1), is2(2), is2(3)
-         WRITE(numout,*)
-         WRITE(numout,*) '          output of last computed fields in output.abort.nc file'
+         
+         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 50 m  or  |U| > 20 m/s  or  NaN encounter in the tests'
+         WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2)
+         WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3)
+         WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3)
+         WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3)
+         WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file'
          
          CALL dia_wri_state( 'output.abort' )     ! create an output.abort file
          
-         IF( ln_ctl ) THEN
-            kindic = -3
-            nstop = nstop + 1                            ! increase nstop by 1 (on all local domains)
+         IF( .NOT. ln_ctl ) THEN
+            WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea
+            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 )
          ELSE
-            CALL ctl_stop()
-            CALL mppstop(ld_force_abort = .true.)
+            CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )
          ENDIF
+
+         kindic = -3
          !
       ENDIF