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.
Changeset 10572 – NEMO

Changeset 10572


Ignore:
Timestamp:
2019-01-24T16:37:13+01:00 (5 years ago)
Author:
smasson
Message:

trunk: update tests with latest src

Location:
NEMO/trunk/tests
Files:
3 edited

Legend:

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

    r10566 r10572  
    6767      REAL(wp)               ::   zzz                 ! local real  
    6868      REAL(wp), DIMENSION(9) ::   zmax 
     69      LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    6970      CHARACTER(len=20) :: clname 
    7071      !!---------------------------------------------------------------------- 
    7172      ! 
     73      ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     74      ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) 
     75      ll_wrtruns = ll_colruns .AND. lwm 
    7276      IF( kt == nit000 .AND. lwp ) THEN 
    7377         WRITE(numout,*) 
     
    7680         !                                ! open time.step file 
    7781         IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    78          !                                ! open run.stat file 
    79          IF( ln_ctl .AND. lwm ) THEN 
     82         !                                ! open run.stat file(s) at start whatever 
     83         !                                ! the value of sn_cfctl%ptimincr 
     84         IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN 
    8085            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    8186            clname = 'run.stat.nc' 
     
    99104      IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    100105      ! 
    101       IF(lwm) THEN                        !==  current time step  ==!   ("time.step" file) 
     106      IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
    102107         WRITE ( numstp, '(1x, i8)' )   kt 
    103108         REWIND( numstp ) 
     
    121126      ENDIF 
    122127      ! 
    123       IF( lk_mpp .AND. ln_ctl ) THEN 
     128      IF( ll_colruns ) THEN 
    124129         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    125130         nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains 
    126131      ENDIF 
    127132      !                                   !==  run statistics  ==!   ("run.stat" files) 
    128       IF( ln_ctl .AND. lwm ) THEN 
     133      IF( ll_wrtruns ) THEN 
    129134         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    130135         istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
     
    145150         &  zmax(1) >   50._wp .OR.   &                    ! too large sea surface height ( > 50 m ) 
    146151         &  zmax(2) >   20._wp .OR.   &                    ! too large velocity ( > 20 m/s) 
    147          &  zmax(3) >= 100._wp .OR.   &                    ! too small sea surface salinity ( < -100 ) 
    148          &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
    149          &  zmax(4) < -100._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
    150          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN  ! NaN encounter in the tests 
     152!!$         &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity 
     153!!$         &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
     154!!$         &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
     155         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
    151156         IF( lk_mpp .AND. ln_ctl ) THEN 
    152157            CALL mpp_maxloc( 'stpctl', ABS(sshn)        , ssmask(:,:)  , zzz, ih  ) 
     
    160165            is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    161166         ENDIF 
    162          IF( numout == 6 )   &   ! force to open ocean.output file 
    163             CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    164  
    165          WRITE(numout,cform_err) 
    166          WRITE(numout,*) ' stp_ctl: |ssh| > 50 m  or  |U| > 20 m/s  or  S <= -100  or  S >= 100  or  NaN encounter in the tests' 
    167          WRITE(numout,*) ' ======= ' 
    168          IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea 
    169          WRITE(numout,9100) kt,   zmax(1), ih(1) , ih(2) 
    170          WRITE(numout,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
    171          WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
    172          WRITE(numout,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
    173          WRITE(numout,*) 
    174          WRITE(numout,*) '          output of last computed fields in output.abort.nc file' 
     167          
     168         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 50 m  or  |U| > 20 m/s  or  NaN encounter in the tests' 
     169         WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2) 
     170         WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
     171         WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
     172         WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
     173         WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file' 
    175174          
    176175         CALL dia_wri_state( 'output.abort' )     ! create an output.abort file 
    177176          
    178          IF( ln_ctl ) THEN 
    179             kindic = -3 
    180             nstop = nstop + 1                            ! increase nstop by 1 (on all local domains) 
     177         IF( .NOT. ln_ctl ) THEN 
     178            WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 
     179            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 ) 
    181180         ELSE 
    182             CALL ctl_stop() 
    183             CALL mppstop(ld_force_abort = .true.) 
     181            CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' ) 
    184182         ENDIF 
     183 
     184         kindic = -3 
    185185         ! 
    186186      ENDIF 
  • NEMO/trunk/tests/CANAL/MY_SRC/trazdf.F90

    r10425 r10572  
    136136      ! 
    137137      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    138       REAL(wp) ::  zrhs            ! local scalars 
     138      REAL(wp) ::  zrhs, zzwi, zzws ! local scalars 
    139139      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwi, zwt, zwd, zws 
    140140      !!--------------------------------------------------------------------- 
     
    177177            ! 
    178178            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
    179             DO jk = 1, jpkm1 
    180                DO jj = 2, jpjm1 
    181                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    182 !!gm BUG  I think, use e3w_a instead of e3w_n, not sure of that 
    183                      zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  ) 
    184                      zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 
    185                      zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    186                  END DO 
    187                END DO 
    188             END DO 
     179            IF( ln_zad_Aimp ) THEN         ! Adaptive implicit vertical advection 
     180               DO jk = 1, jpkm1 
     181                  DO jj = 2, jpjm1 
     182                     DO ji = fs_2, fs_jpim1   ! vector opt. (ensure same order of calculation as below if wi=0.) 
     183                        zzwi = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  ) 
     184                        zzws = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 
     185                        zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zzwi - zzws   & 
     186                           &                 + p2dt * ( MAX( wi(ji,jj,jk  ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 
     187                        zwi(ji,jj,jk) = zzwi + p2dt *   MIN( wi(ji,jj,jk  ) , 0._wp ) 
     188                        zws(ji,jj,jk) = zzws - p2dt *   MAX( wi(ji,jj,jk+1) , 0._wp ) 
     189                    END DO 
     190                  END DO 
     191               END DO 
     192            ELSE 
     193               DO jk = 1, jpkm1 
     194                  DO jj = 2, jpjm1 
     195                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     196                        zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk) 
     197                        zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 
     198                        zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     199                    END DO 
     200                  END DO 
     201               END DO 
     202            ENDIF 
    189203            ! 
    190204            !! Matrix inversion from the first level 
  • NEMO/trunk/tests/VORTEX/MY_SRC/domvvl.F90

    r10425 r10572  
    938938               END DO 
    939939               e3t_n(:,:,:) = e3t_b(:,:,:) 
    940 !!$                sshn(:,:)=0._wp 
     940               sshn(:,:) = sshb(:,:)   ! needed later for gde3w 
    941941!!$                e3t_n(:,:,:)=e3t_0(:,:,:) 
    942942!!$                e3t_b(:,:,:)=e3t_0(:,:,:) 
Note: See TracChangeset for help on using the changeset viewer.