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 474 for trunk – NEMO

Changeset 474 for trunk


Ignore:
Timestamp:
2006-05-11T17:24:19+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_061: SM: end of ctl_stop + mpi optimization in _bilap

Location:
trunk/NEMO
Files:
39 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/C1D_SRC/step1d.F90

    r468 r474  
    266266      !                                            ! Time loop: control and print 
    267267                       CALL stp_ctl( kstp, indic ) 
    268                        IF ( indic < 0 )   nstop = nstop + 1 
     268                       IF ( indic < 0 ) CALL ctl_stop( 'step1d: indic < 0' ) 
    269269 
    270270      IF ( nstop == 0 ) THEN 

  • trunk/NEMO/LIM_SRC/limistate.F90

    r419 r474  
    327327             
    328328         ELSE 
    329             IF(lwp) WRITE(numout,cform_err)  
    330             IF(lwp) WRITE(numout,*) '            ',cl_icedata, ' not found !' 
    331             nstop = nstop + 1 
     329            WRITE(ctmp1,*) '            ',cl_icedata, ' not found !' 
     330            CALL ctl_stop( ctmp1 ) 
    332331         ENDIF 
    333332      ENDIF 

  • trunk/NEMO/LIM_SRC/limrst_dimg.h90

    r391 r474  
    191191       
    192192      IF( ( it0 - it1 ) /= 1 .AND. ABS( nrstdt ) == 1 ) THEN 
    193          IF (lwp) THEN 
    194          WRITE(numout,cform_err) 
    195          WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart' 
    196          WRITE(numout,*) ' we stop. verify the file or rerun with the value  0 for the' 
    197          WRITE(numout,*) ' control of time parameter  nrstdt' 
    198          END IF 
    199          nstop = nstop + 1 
     193         CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',   & 
     194         &              ' we stop. verify the file or rerun with the value  0 for the',   & 
     195         &          ' control of time parameter  nrstdt' ) 
    200196      ENDIF 
    201197 

  • trunk/NEMO/OPA_SRC/DIA/diafwb.F90

    r407 r474  
    198198         CASE DEFAULT                                !    ORCA R05 or R025 
    199199            !                                        ! ======================= 
    200             IF(lwp) WRITE(numout,cform_err) 
    201             IF(lwp) WRITE(numout,*)' dia_fwb Not yet implemented in ORCA_R05 or R025' 
    202             nstop = nstop + 1 
     200            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' ) 
    203201            !  
    204202         END SELECT 
    … …  
    242240         CASE DEFAULT                                !    ORCA R05 or R025 
    243241            !                                        ! ======================= 
    244             IF(lwp) WRITE(numout,cform_err) 
    245             IF(lwp) WRITE(numout,*)' dia_fwb Not yet implemented in ORCA_R05 or R025' 
    246             nstop = nstop + 1 
     242            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' ) 
    247243            !  
    248244         END SELECT 
    … …  
    286282         CASE DEFAULT                                !    ORCA R05 or R025 
    287283            !                                        ! ======================= 
    288             IF(lwp) WRITE(numout,cform_err) 
    289             IF(lwp) WRITE(numout,*)' dia_fwb Not yet implemented in ORCA_R05 or R025' 
    290             nstop = nstop + 1 
     284            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' ) 
    291285            !  
    292286         END SELECT 
    … …  
    330324         CASE DEFAULT                                !    ORCA R05 or R025 
    331325            !                                        ! ======================= 
    332             IF(lwp) WRITE(numout,cform_err) 
    333             IF(lwp) WRITE(numout,*)' dia_fwb Not yet implemented in ORCA_R05 or R025' 
    334             nstop = nstop + 1 
     326            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' ) 
    335327            !  
    336328         END SELECT 

  • trunk/NEMO/OPA_SRC/DIA/diahdy.F90

    r460 r474  
    107107         IF(lwp) WRITE(numout,*) 'dia_hdy : computation of dynamical heigh' 
    108108         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    109          IF( .NOT. ln_zco ) THEN      ! Dynamic height diagnostics only implemented in z-coordinate 
    110             IF(lwp) WRITE(numout,cform_err) 
    111             IF(lwp) WRITE(numout,*) '          ln_zps or ln_sco, Dynamical height diagnostics not yet implemented' 
    112             nstop = nstop + 1 
    113          ENDIF 
     109         IF( .NOT. ln_zco )   & 
     110              &   CALL ctl_stop( '          ln_zps or ln_sco, Dynamical height diagnostics not yet implemented' ) 
    114111         DO jk = 1, jpk 
    115112            IF( gdepw_0(jk) > zgdsup ) GOTO 110 

  • trunk/NEMO/OPA_SRC/DIA/diaspr.F90

    r359 r474  
    142142         ! control 
    143143# if ! defined key_dynspg_rl 
    144       IF(lwp) WRITE(numout,cform_err) 
    145       IF(lwp) WRITE(numout,*) '          surface pressure already explicitly computed !!' 
    146       nstop = nstop + 1 
     144      CALL ctl_stop( '          surface pressure already explicitly computed !!' ) 
    147145# endif 
    148146 

  • trunk/NEMO/OPA_SRC/DOM/domcfg.F90

    r434 r474  
    6565                                                                  ' north fold with F-point pivot' 
    6666      ENDIF 
    67       IF( jperio <  0 .OR. jperio > 6 ) THEN 
    68           IF(lwp) WRITE(numout,cform_err) 
    69           IF(lwp) WRITE(numout,*) 'jperio is out of range' 
    70           nstop = nstop + 1 
    71       ENDIF 
    72  
     67      IF( jperio <  0 .OR. jperio > 6 ) CALL ctl_stop( 'jperio is out of range' ) 
    7368 
    7469      ! global domain versus zoom and/or local domain 
    … …  
    161156      ! zoom control 
    162157      IF( jpiglo + jpizoom - 1  >  jpidta .OR.   & 
    163           jpjglo + jpjzoom - 1  >  jpjdta      ) THEN 
    164          IF(lwp)WRITE(numout,cform_err) 
    165          IF(lwp)WRITE(numout,*)' global or zoom domain exceed the data domain ! ' 
    166          nstop = nstop + 1 
    167       ENDIF 
     158          jpjglo + jpjzoom - 1  >  jpjdta      ) & 
     159          &   CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' ) 
    168160 
    169161      ! set zoom flag 
    … …  
    185177         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)' 
    186178      ENDIF 
    187       IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  ) THEN 
    188          IF(lwp)WRITE(numout,cform_err) 
    189          IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with east-west cyclic boundary condition' 
    190          nstop = nstop + 1 
    191       ENDIF 
    192       IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  ) THEN 
    193          IF(lwp)WRITE(numout,cform_err) 
    194          IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with North fold boundary condition' 
    195          nstop = nstop + 1 
    196       ENDIF 
    197       IF(  lzoom  .AND.  lk_isl  ) THEN 
    198          IF(lwp)WRITE(numout,cform_err) 
    199          IF(lwp)WRITE(numout,*)' key_islands and zoom are not allowed' 
    200          nstop = nstop + 1 
    201       ENDIF 
     179      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  )   & 
     180           &   CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' ) 
     181      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  )   & 
     182           &   CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' ) 
     183      IF(  lzoom  .AND.  lk_isl  ) CALL ctl_stop( ' key_islands and zoom are not allowed' ) 
    202184 
    203185      ! Pre-defined arctic/antarctic zoom of ORCA configuration flag 

  • trunk/NEMO/OPA_SRC/DOM/dommsk.F90

    r454 r474  
    152152          IF(lwp) WRITE(numout,*) '         ocean lateral  strong-slip ' 
    153153        ELSE 
    154           IF(lwp) WRITE(numout,cform_err) 
    155           IF(lwp) WRITE(numout,*) ' shlat is negative = ', shlat 
    156           nstop = nstop + 1 
     154          WRITE(ctmp1,*) ' shlat is negative = ', shlat 
     155          CALL ctl_stop( ctmp1 ) 
    157156      ENDIF 
    158157 
    … …  
    507506      IF(lwp)WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 
    508507      IF(lwp)WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme' 
    509       IF( lk_mpp ) THEN 
    510          IF(lwp)WRITE(numout,cform_err) 
    511          IF(lwp)WRITE(numout,*) ' mpp version is not yet implemented' 
    512          nstop = nstop + 1 
    513       ENDIF 
     508      IF( lk_mpp ) CALL ctl_stop( ' mpp version is not yet implemented' ) 
    514509 
    515510      ! mask for second order calculation of vorticity 
    … …  
    606601         IF( npcoa(1,jk) > itest .OR. npcoa(2,jk) > itest .OR.   & 
    607602             npcoa(3,jk) > itest .OR. npcoa(4,jk) > itest ) THEN 
    608             WRITE(numout,*) 
    609             WRITE(numout,*) ' level jk = ',jk 
    610             WRITE(numout,*) ' straight coast index arraies are too small.:' 
    611             WRITE(numout,*) ' npe, npw, nps, npn = ', npcoa(1,jk), npcoa(2,jk),   & 
     603             
     604            WRITE(ctmp1,*) ' level jk = ',jk 
     605            WRITE(ctmp2,*) ' straight coast index arraies are too small.:' 
     606            WRITE(ctmp3,*) ' npe, npw, nps, npn = ', npcoa(1,jk), npcoa(2,jk),   & 
    612607                &                                     npcoa(3,jk), npcoa(4,jk) 
    613             WRITE(numout,*) ' 2*(jpi+jpj) = ',itest,'. we stop.' 
    614             STOP   !!bug nstop to be used 
     608            WRITE(ctmp4,*) ' 2*(jpi+jpj) = ',itest,'. we stop.' 
     609            CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4 ) 
    615610        ENDIF 
    616611      END DO 
    … …  
    664659               &                  '  Point(',icoord(jl,1),',',icoord(jl,2),')' 
    665660         END DO 
    666          IF(lwp) WRITE(numout,*) 'We stop...'   !!cr print format to be used 
    667          nstop = nstop + 1 
     661         CALL ctl_stop( 'We stop...' ) 
    668662      ENDIF 
    669663 

  • trunk/NEMO/OPA_SRC/DOM/domstp.F90

    r454 r474  
    8888            IF(lwp) WRITE(numout,*)'               accelerating the convergence' 
    8989            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours' 
    90             IF( ln_sco .AND. rdtmin /= rdtmax ) THEN 
    91                IF(lwp) WRITE(numout,cform_err) 
    92                IF(lwp) WRITE(numout,*)' depth dependent acceleration of & 
    93                                       &convergence not implemented in s-coordinates' 
    94                nstop = nstop + 1 
    95             ENDIF 
     90            IF( ln_sco .AND. rdtmin /= rdtmax )   & 
     91                 & CALL ctl_stop ( ' depth dependent acceleration of convergence not implemented in s-coordinates' ) 
    9692            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level' 
    9793 
    … …  
    108104         CASE DEFAULT              ! E R R O R  
    109105 
    110             IF(lwp) WRITE(numout,cform_err) 
    111             IF(lwp) WRITE(numout,*) ' nacc value e r r o r, nacc= ',nacc 
    112             IF(lwp) WRITE(numout,*) ' we stop' 
    113             nstop = nstop + 1 
     106            WRITE(ctmp1,*) ' nacc value e r r o r, nacc= ',nacc 
     107            CALL ctl_stop( ctmp1 ) 
    114108 
    115109      END SELECT 

  • trunk/NEMO/OPA_SRC/DYN/dynhpg.F90

    r455 r474  
    203203      IF( ln_hpg_djc )   ioptio = ioptio + 1 
    204204      IF( ln_hpg_rot )   ioptio = ioptio + 1 
    205       IF ( ioptio > 1 ) THEN 
    206           IF(lwp) WRITE(numout,cform_err) 
    207           IF(lwp) WRITE(numout,*) ' several hydrostatic pressure gradient options used' 
    208           nstop = nstop + 1 
    209       ENDIF 
     205      IF ( ioptio > 1 )   & 
     206           &   CALL ctl_stop( ' several hydrostatic pressure gradient options used' ) 
    210207 
    211208      IF( lk_dynhpg_jki ) THEN 

  • trunk/NEMO/OPA_SRC/DYN/dynldf.F90

    r456 r474  
    152152      IF( ln_dynldf_lap   )   ioptio = ioptio + 1 
    153153      IF( ln_dynldf_bilap )   ioptio = ioptio + 1 
    154       IF( ioptio /= 1 )   THEN 
    155           IF(lwp) WRITE(numout,cform_err) 
    156           IF(lwp) WRITE(numout,*) '          use ONE of the 2 lap/bilap operator type on dynamics' 
    157           nstop = nstop + 1 
    158       ENDIF 
     154      IF( ioptio /= 1 ) CALL ctl_stop( '          use ONE of the 2 lap/bilap operator type on dynamics' ) 
    159155      ioptio = 0 
    160156      IF( ln_dynldf_level )   ioptio = ioptio + 1 
    161157      IF( ln_dynldf_hor   )   ioptio = ioptio + 1 
    162158      IF( ln_dynldf_iso   )   ioptio = ioptio + 1 
    163       IF( ioptio /= 1 ) THEN 
    164          IF(lwp) WRITE(numout,cform_err) 
    165          IF(lwp) WRITE(numout,*) '          use only ONE direction (level/hor/iso)' 
    166          nstop = nstop + 1 
    167       ENDIF 
     159      IF( ioptio /= 1 ) CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    168160 
    169161      ! defined the type of lateral diffusion from ln_dynldf_... logicals 
    … …  
    205197      ENDIF 
    206198 
    207       IF( ierr == 1 ) THEN 
    208          IF(lwp) WRITE(numout,cform_err) 
    209          IF(lwp) WRITE(numout,*) ' iso-level in z-coordinate - partial step, not allowed' 
    210          nstop = nstop + 1 
    211       ENDIF 
    212       IF( ierr == 2 ) THEN 
    213          IF(lwp) WRITE(numout,cform_err) 
    214          IF(lwp) WRITE(numout,*) ' isoneutral bilaplacian operator does not exist' 
    215          nstop = nstop + 1 
    216       ENDIF 
     199      IF( ierr == 1 )   & 
     200           &   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
     201      IF( ierr == 2 )   & 
     202           &   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
    217203      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    218          IF( .NOT.lk_ldfslp ) THEN 
    219             IF(lwp) WRITE(numout,cform_err) 
    220             IF(lwp) WRITE(numout,*) '          the rotation of the diffusive tensor require key_ldfslp' 
    221             nstop = nstop + 1 
    222          ENDIF 
     204         IF( .NOT.lk_ldfslp )   & 
     205           &   CALL ctl_stop(  '          the rotation of the diffusive tensor require key_ldfslp' ) 
    223206      ENDIF 
    224207 

  • trunk/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r455 r474  
    8686      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v ! temporary scalar 
    8787      REAL(wp), DIMENSION(jpi,jpj) ::   & 
    88          zuf, zut, zlu, zlv, zcu, zcv         ! temporary workspace 
     88         zcu, zcv                             ! temporary workspace 
     89      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
     90         zuf, zut, zlu, zlv                   ! temporary workspace 
    8991      !!---------------------------------------------------------------------- 
    9092      !!  OPA 8.5, LODYC-IPSL (2002) 
    … …  
    9698         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
    9799      ENDIF 
    98       zuf(:,:) = 0.e0 
    99       zut(:,:) = 0.e0 
    100       zlu(:,:) = 0.e0 
    101       zlv(:,:) = 0.e0 
     100 
     101!!bug gm this should be enough 
     102!!$      zuf(:,:,jpk) = 0.e0 
     103!!$      zut(:,:,jpk) = 0.e0 
     104!!$      zlu(:,:,jpk) = 0.e0 
     105!!$      zlv(:,:,jpk) = 0.e0 
     106      zuf(:,:,:) = 0.e0 
     107      zut(:,:,:) = 0.e0 
     108      zlu(:,:,:) = 0.e0 
     109      zlv(:,:,:) = 0.e0 
    102110 
    103111      !                                                ! =============== 
    … …  
    108116 
    109117         IF( ln_sco .OR. ln_zps ) THEN   ! s-coordinate or z-coordinate with partial steps 
    110             zuf(:,:) = rotb(:,:,jk) * fse3f(:,:,jk) 
     118            zuf(:,:,jk) = rotb(:,:,jk) * fse3f(:,:,jk) 
    111119            DO jj = 2, jpjm1 
    112120               DO ji = fs_2, fs_jpim1   ! vector opt. 
    113                   zlu(ji,jj) = - ( zuf(ji,jj) - zuf(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
     121                  zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    114122                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj) 
    115123    
    116                   zlv(ji,jj) = + ( zuf(ji,jj) - zuf(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
     124                  zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    117125                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj) 
    118126               END DO 
    … …  
    121129            DO jj = 2, jpjm1 
    122130               DO ji = fs_2, fs_jpim1   ! vector opt. 
    123                   zlu(ji,jj) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   & 
     131                  zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   & 
    124132                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj) 
    125133    
    126                   zlv(ji,jj) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   & 
     134                  zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   & 
    127135                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj) 
    128136               END DO   
    129137            END DO   
    130138         ENDIF 
    131  
    132          ! Boundary conditions on the laplacian  (zlu,zlv) 
    133          CALL lbc_lnk( zlu, 'U', -1. ) 
    134          CALL lbc_lnk( zlv, 'V', -1. ) 
    135           
    136           
     139      ENDDO 
     140 
     141      ! Boundary conditions on the laplacian  (zlu,zlv) 
     142      CALL lbc_lnk( zlu, 'U', -1. ) 
     143      CALL lbc_lnk( zlv, 'V', -1. ) 
     144          
     145          
     146      DO jk = 1, jpkm1 
     147    
    137148         ! Third derivative 
    138149         ! ---------------- 
    139150          
    140151         ! Multiply by the eddy viscosity coef. (at u- and v-points) 
    141          zlu(:,:) = zlu(:,:) * fsahmu(:,:,jk) 
    142          zlv(:,:) = zlv(:,:) * fsahmv(:,:,jk) 
     152         zlu(:,:,jk) = zlu(:,:,jk) * fsahmu(:,:,jk) 
     153         zlv(:,:,jk) = zlv(:,:,jk) * fsahmv(:,:,jk) 
    143154          
    144155         ! Contravariant "laplacian" 
    145          zcu(:,:) = e1u(:,:) * zlu(:,:) 
    146          zcv(:,:) = e2v(:,:) * zlv(:,:) 
     156         zcu(:,:) = e1u(:,:) * zlu(:,:,jk) 
     157         zcv(:,:) = e2v(:,:) * zlv(:,:,jk) 
    147158          
    148159         ! Laplacian curl ( * e3f if s-coordinates or z-coordinate with partial steps) 
    149160         DO jj = 1, jpjm1 
    150161            DO ji = 1, fs_jpim1   ! vector opt. 
    151                zuf(ji,jj) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      & 
     162               zuf(ji,jj,jk) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      & 
    152163                  &                            - zcu(ji  ,jj+1) + zcu(ji,jj)  )   & 
    153164#if defined key_zco 
    … …  
    163174            DO ji = 1, fs_jpim1   ! vector opt. 
    164175#if defined key_zco 
    165                zlu(ji,jj) = e2u(ji,jj) * zlu(ji,jj) 
    166                zlv(ji,jj) = e1v(ji,jj) * zlv(ji,jj) 
    167 #else 
    168                zlu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * zlu(ji,jj) 
    169                zlv(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * zlv(ji,jj) 
     176               zlu(ji,jj,jk) = e2u(ji,jj) * zlu(ji,jj,jk) 
     177               zlv(ji,jj,jk) = e1v(ji,jj) * zlv(ji,jj,jk) 
     178#else 
     179               zlu(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * zlu(ji,jj,jk) 
     180               zlv(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * zlv(ji,jj,jk) 
    170181#endif 
    171182            END DO 
    … …  
    180191               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    181192#endif 
    182                zut(ji,jj) = (  zlu(ji,jj) - zlu(ji-1,jj  )   & 
    183                   &          + zlv(ji,jj) - zlv(ji  ,jj-1) ) / zbt 
     193               zut(ji,jj,jk) = (  zlu(ji,jj,jk) - zlu(ji-1,jj  ,jk)   & 
     194                  &             + zlv(ji,jj,jk) - zlv(ji  ,jj-1,jk) ) / zbt 
    184195            END DO 
    185196         END DO 
     197      END DO 
    186198 
    187199 
    188200      ! boundary conditions on the laplacian curl and div (zuf,zut) 
     201!!bug gm no need to do this 2 following lbc... 
    189202      CALL lbc_lnk( zuf, 'F', 1. ) 
    190203      CALL lbc_lnk( zut, 'T', 1. ) 
    191204 
    192           
     205      DO jk = 1, jpkm1       
     206    
    193207         ! Bilaplacian 
    194208         ! ----------- 
    … …  
    204218#endif 
    205219               ! horizontal biharmonic diffusive trends 
    206                zua = - ( zuf(ji  ,jj) - zuf(ji,jj-1) ) / ze2u   & 
    207                   &  + ( zut(ji+1,jj) - zut(ji,jj  ) ) / e1u(ji,jj) 
    208  
    209                zva = + ( zuf(ji,jj  ) - zuf(ji-1,jj) ) / ze2v   & 
    210                   &  + ( zut(ji,jj+1) - zut(ji  ,jj) ) / e2v(ji,jj) 
     220               zua = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   & 
     221                  &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) / e1u(ji,jj) 
     222 
     223               zva = + ( zuf(ji,jj  ,jk) - zuf(ji-1,jj,jk) ) / ze2v   & 
     224                  &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj) 
    211225               ! add it to the general momentum trends 
    212226               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 

  • trunk/NEMO/OPA_SRC/DYN/dynspg.F90

    r372 r474  
    168168      IF(lk_dynspg_rl )   ioptio = ioptio + 1 
    169169 
    170       IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 ) THEN 
    171          IF(lwp) WRITE(numout,cform_err) 
    172          IF(lwp) WRITE(numout,*) ' Choose only one surface pressure gradient scheme with a key cpp' 
    173          nstop = nstop + 1 
    174       ENDIF 
     170      IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 )   & 
     171           &   CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' ) 
    175172 
    176173      IF( lk_esopa     )   nspg = -1 
    … …  
    199196      ! -------------------------- 
    200197      IF( lk_dynspg_ts ) THEN 
    201          IF( MOD( rdt , rdtbt ) /= 0. ) THEN 
    202             IF(lwp) WRITE(numout,cform_err) 
    203             IF(lwp) WRITE(numout,*) ' The barotropic timestep must be an integer divisor of the baroclinic timestep' 
    204             nstop = nstop + 1 
    205          ENDIF 
     198         IF( MOD( rdt , rdtbt ) /= 0. )   & 
     199           &   CALL ctl_stop( ' The barotropic timestep must be an integer divisor of the baroclinic timestep' ) 
    206200      ENDIF 
    207201 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r455 r474  
    286286            CALL sol_sor_e( kindic ) 
    287287         ELSE                          ! e r r o r in nsolv namelist parameter 
    288             IF(lwp) WRITE(numout,cform_err) 
    289             IF(lwp) WRITE(numout,*) ' dyn_spg_flt : e r r o r, nsolv = 1, 2 ,3 or 4' 
    290             IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~                not = ', nsolv 
    291             nstop = nstop + 1 
     288            WRITE(ctmp1,*) ' ~~~~~~~~~~~                not = ', nsolv 
     289            CALL ctl_stop( ' dyn_spg_flt : e r r o r, nsolv = 1, 2 ,3 or 4', ctmp1 ) 
    292290         ENDIF 
    293291      ENDIF 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_flt_jki.F90

    r455 r474  
    300300            CALL sol_sor_e( kindic ) 
    301301         ELSE                          ! e r r o r in nsolv namelist parameter 
    302             IF(lwp) WRITE(numout,cform_err) 
    303             IF(lwp) WRITE(numout,*) ' dyn_spg_flt_jki : e r r o r, nsolv = 1, 2, 3 or 4' 
    304             IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                not = ', nsolv 
    305             nstop = nstop + 1 
    306          ENDIF 
     302            WRITE(ctmp1,*) ' ~~~~~~~~~~~~~~~~                not = ', nsolv 
     303            CALL ctl_stop( ' dyn_spg_flt_jki : e r r o r, nsolv = 1, 2, 3 or 4', ctmp1 ) 
    307304      ENDIF 
    308305 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_rl.F90

    r359 r474  
    229229            CALL sol_sor_e( kindic ) 
    230230         CASE DEFAULT                  ! e r r o r in nsolv namelist parameter 
    231             IF(lwp) WRITE(numout,cform_err) 
    232             IF(lwp) WRITE(numout,*) ' dyn_spg_rl : e r r o r, nsolv = 1, 2 ,3 or 4' 
    233             IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~                not = ', nsolv 
    234             nstop = nstop + 1 
     231            WRITE(ctmp1,*) ' ~~~~~~~~~~                not = ', nsolv 
     232            CALL ctl_stop( ' dyn_spg_rl : e r r o r, nsolv = 1, 2 ,3 or 4', ctmp1 ) 
    235233         END SELECT 
    236234      ENDIF 

  • trunk/NEMO/OPA_SRC/DYN/dynvor.F90

    r455 r474  
    677677         ioptio = ioptio + 1 
    678678      ENDIF 
    679       IF( ioptio /= 1 .AND. .NOT. lk_esopa ) THEN 
    680          WRITE(numout,cform_err) 
    681          IF(lwp) WRITE(numout,*) ' use ONE and ONLY one vorticity scheme' 
    682          nstop = nstop + 1 
    683       ENDIF 
     679      IF( ioptio /= 1 .AND. .NOT. lk_esopa ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' ) 
    684680      IF( lk_esopa ) THEN 
    685681         nvor = -1 

  • trunk/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r461 r474  
    122122      IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )' 
    123123      ioptio = ioptio+1 
    124       IF( ln_sco ) THEN 
    125          IF(lwp) WRITE(numout,cform_err) 
    126          IF(lwp) WRITE(numout,*) '          key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' 
    127          nstop = nstop + 1 
    128       ENDIF 
     124      IF( ln_sco ) CALL ctl_stop( '          key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' ) 
    129125#endif 
    130126      IF( ioptio == 0 ) THEN 
    131127          IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant  (default option)' 
    132128        ELSEIF( ioptio > 1 ) THEN 
    133           IF(lwp) WRITE(numout,cform_err) 
    134           IF(lwp) WRITE(numout,*) '          use only one of the following keys:',   & 
    135                                   ' key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' 
    136           nstop = nstop + 1 
     129           CALL ctl_stop( '          use only one of the following keys:',   & 
     130                &         ' key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' ) 
    137131      ENDIF 
    138132 
    … …  
    140134      IF( ln_dynldf_bilap ) THEN 
    141135         IF(lwp) WRITE(numout,*) '          biharmonic momentum diffusion' 
    142          IF( ahm0 > 0 .AND. .NOT. lk_esopa ) THEN 
    143             IF(lwp) WRITE(numout,cform_err) 
    144             IF(lwp) WRITE(numout,*) 'The horizontal viscosity coef. ahm0 must be negative' 
    145             nstop = nstop + 1 
    146          ENDIF 
     136         IF( ahm0 > 0 .AND. .NOT. lk_esopa )   & 
     137              &   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' ) 
    147138      ELSE 
    148139         IF(lwp) WRITE(numout,*) '          harmonic momentum diff. (default)' 
    149          IF( ahm0 < 0 .AND. .NOT. lk_esopa ) THEN 
    150             IF(lwp) WRITE(numout,cform_err) 
    151             IF(lwp) WRITE(numout,*) '          The horizontal viscosity coef. ahm0 must be positive' 
    152             nstop = nstop + 1 
    153          ENDIF 
     140         IF( ahm0 < 0 .AND. .NOT. lk_esopa ) & 
     141              &   CALL ctl_stop( '          The horizontal viscosity coef. ahm0 must be positive' ) 
    154142      ENDIF 
    155143 

  • trunk/NEMO/OPA_SRC/LDF/ldftra.F90

    r461 r474  
    112112      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
    113113      ioptio = ioptio + 1 
    114       IF( .NOT. ln_zco ) THEN 
    115          IF(lwp) WRITE(numout,cform_err) 
    116          IF(lwp) WRITE(numout,*) '          key_traldf_c1d can only be used in z-coordinate - full step' 
    117          nstop = nstop + 1 
    118       ENDIF 
     114      IF( .NOT. ln_zco ) & 
     115           &   CALL ctl_stop( '          key_traldf_c1d can only be used in z-coordinate - full step' ) 
    119116#endif 
    120117      IF( ioptio == 0 ) THEN 
    121118          IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant (default option)' 
    122119        ELSEIF( ioptio > 1 ) THEN 
    123           IF(lwp) WRITE(numout,cform_err) 
    124           IF(lwp) WRITE(numout,*) '          use only one of the following keys:',   & 
    125              &                    ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' 
    126           nstop = nstop + 1 
     120           CALL ctl_stop('          use only one of the following keys:',   & 
     121             &           ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' ) 
    127122      ENDIF 
    128123 
    129124      IF( ln_traldf_bilap ) THEN 
    130125         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
    131          IF( aht0 > 0 .AND. .NOT. lk_esopa ) THEN 
    132             IF(lwp) WRITE(numout,cform_err) 
    133             IF(lwp) WRITE(numout,*) '          The horizontal diffusivity coef. aht0 must be negative' 
    134             nstop = nstop + 1 
    135          ENDIF 
     126         IF( aht0 > 0 .AND. .NOT. lk_esopa )   & 
     127              &   CALL ctl_stop( '          The horizontal diffusivity coef. aht0 must be negative' ) 
    136128      ELSE 
    137129         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
    138          IF( aht0 < 0 .AND. .NOT. lk_esopa ) THEN 
    139             IF(lwp) WRITE(numout,cform_err) 
    140             IF(lwp) WRITE(numout,*) '          The horizontal diffusivity coef. aht0 must be positive' 
    141             nstop = nstop + 1 
    142          ENDIF 
     130         IF( aht0 < 0 .AND. .NOT. lk_esopa )   & 
     131              &   CALL ctl_stop('          The horizontal diffusivity coef. aht0 must be positive' ) 
    143132      ENDIF 
    144133 

  • trunk/NEMO/OPA_SRC/OBC/obcdom.F90

    r247 r474  
    109109      ! ------------------------------------------------ 
    110110       
    111       IF( nbobc == 1 .OR. nbic == 0 ) THEN  
    112          IF(lwp) WRITE(numout,*) 
    113          IF(lwp) WRITE(numout,*) ' obc_dom: No isolated coastlines gcfobc is set to zero' 
    114          IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    115          nstop = nstop + 1 
    116       END IF 
     111      IF( nbobc == 1 .OR. nbic == 0 ) CALL ctl_stop( ' obc_dom: No isolated coastlines gcfobc is set to zero' ) 
    117112 
    118113      ! 2. Lecture of 'coastlines' file 
    … …  
    190185 
    191186      IF( icheck /= 0 ) THEN 
    192          IF(lwp) WRITE(numout,cform_err) 
    193          IF(lwp) WRITE(numout,*) 'obc_dom : tmask and isolated coastlines mask are not equal', icheck 
    194          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    195          nstop = nstop + 1 
     187         WRITE(ctmp1,*) 'obc_dom : tmask and isolated coastlines mask are not equal', icheck 
     188    CALL ctl_stop( ctmp1 ) 
    196189      END IF 
    197190 
    … …  
    350343      DO jnic = 1, nbobc-1 
    351344         IF( mnic(0,jnic) > jpnic ) THEN 
    352             IF(lwp) WRITE(numout,cform_err) 
    353             IF(lwp) WRITE(numout,*) 'obc_dom: isolated coastline ',jnic,   & 
    354                ' has ',ip,' grid-points > ',jpnic  
    355             IF(lwp) WRITE(numout,*) '~~~~~~~' 
    356             IF(lwp) WRITE(numout,*) ' modify this dimension in obc_dom' 
    357             nstop = nstop + 1 
     345            WRITE(ctmp1,*) 'obc_dom: isolated coastline ',jnic,' has ',ip,' grid-points > ',jpnic  
     346            CALL ctl_stop( ctmp1 ) 
    358347         END IF 
    359348         IF( mnic(0,jnic) == 0 ) THEN 
    360             IF(lwp) WRITE(numout,cform_err) 
    361             IF(lwp) WRITE(numout,*) 'obc_dom: isolated coastline ',jnic,   & 
    362                ' has 0  grid-points verify coastlines file' 
    363             IF(lwp) WRITE(numout,*) '~~~~~~~' 
    364             nstop = nstop + 1 
     349            WRITE(ctmp1,*) 'obc_dom: isolated coastline ',jnic,' has 0  grid-points verify coastlines file' 
     350            CALL ctl_stop( ctmp1 ) 
    365351         END IF 
    366352      END DO 

  • trunk/NEMO/OPA_SRC/OBC/obcini.F90

    r416 r474  
    122122      IF(lwp) WRITE(numout,*) '         Number of open boundaries    nbobc = ',nbobc 
    123123      IF(lwp) WRITE(numout,*) 
    124       IF( nbobc /= 0 .AND. jperio /= 0 ) THEN 
    125          IF(lwp) WRITE(numout,*) 
    126          IF(lwp) WRITE(numout,*) ' E R R O R : Cyclic or symmetric,',   & 
    127             ' and open boundary condition are not compatible' 
    128          IF(lwp) WRITE(numout,*) ' ========== ' 
    129          IF(lwp) WRITE(numout,*) 
    130          nstop = nstop + 1 
    131       END IF 
     124      IF( nbobc /= 0 .AND. jperio /= 0 ) & 
     125           &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) 
    132126 
    133127      ! control prints 
    … …  
    204198            inumfbc = inumfbc+1 
    205199         ELSEIF ( (rdpein*rdpeob) == 0 )  THEN 
    206             IF(lwp) THEN 
    207                WRITE(numout,cform_err) 
    208                WRITE(numout,*) 'obc_init : rdpein & rdpeob must be both zero or non zero' 
    209                nstop = nstop + 1 
    210             ENDIF 
     200            CALL ctl_stop( 'obc_init : rdpein & rdpeob must be both zero or non zero' ) 
    211201         END IF 
    212202      END IF 
    … …  
    218208            inumfbc = inumfbc+1 
    219209         ELSEIF ( (rdpwin*rdpwob) == 0 )  THEN 
    220             IF(lwp) THEN 
    221                WRITE(numout,cform_err) 
    222                WRITE(numout,*) 'obc_init : rdpwin & rdpwob must be both zero or non zero' 
    223                nstop = nstop + 1 
    224             ENDIF 
     210            CALL ctl_stop( 'obc_init : rdpwin & rdpwob must be both zero or non zero' ) 
    225211         END IF 
    226212      END IF 
    … …  
    232218            inumfbc = inumfbc+1 
    233219         ELSEIF ( (rdpnin*rdpnob) == 0 )  THEN 
    234             IF(lwp) THEN 
    235                WRITE(numout,cform_err) 
    236                WRITE(numout,*) 'obc_init : rdpnin & rdpnob must be both zero or non zero' 
    237                nstop = nstop + 1 
    238             ENDIF 
     220            CALL ctl_stop( 'obc_init : rdpnin & rdpnob must be both zero or non zero' ) 
    239221         END IF 
    240222      END IF 
    … …  
    246228            inumfbc = inumfbc+1 
    247229         ELSEIF ( (rdpsin*rdpsob) == 0 )  THEN 
    248             IF(lwp) THEN 
    249                WRITE(numout,cform_err) 
    250                WRITE(numout,*) 'obc_init : rdpsin & rdpsob must be both zero or non zero' 
    251                nstop = nstop + 1 
    252             ENDIF 
     230            CALL ctl_stop( 'obc_init : rdpsin & rdpsob must be both zero or non zero' ) 
    253231         END IF 
    254232      END IF 
    … …  
    605583      IF( lp_obc_west ) THEN 
    606584         IF( jpiwob < 2 .OR.  jpiwob >= jpiglo-2 ) THEN 
    607             IF(lwp) WRITE(numout,*) 
    608             IF(lwp) WRITE(numout,*) ' E R R O R : jpiwob exceed ', jpiglo-2, 'or less than 2' 
    609             IF(lwp) WRITE(numout,*) ' ========== ' 
    610             IF(lwp) WRITE(numout,*) 
    611             nstop = nstop + 1 
     585            WRITE(ctmp1,*) ' jpiwob exceed ', jpiglo-2, 'or less than 2' 
     586            CALL ctl_stop( ctmp1 ) 
    612587         END IF 
    613588         ztestmask(:)=0. 
    … …  
    625600      IF( lp_obc_east ) THEN 
    626601         IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN 
    627             IF(lwp) WRITE(numout,*) 
    628             IF(lwp) WRITE(numout,*) ' E R R O R : jpieob exceed ', jpiglo, ' or less than 4' 
    629             IF(lwp) WRITE(numout,*) ' ========== ' 
    630             IF(lwp) WRITE(numout,*) 
    631             nstop = nstop + 1 
     602            WRITE(ctmp1,*) ' jpieob exceed ', jpiglo, ' or less than 4' 
     603            CALL ctl_stop( ctmp1 ) 
    632604         END IF 
    633605         ztestmask(:)=0. 
    … …  
    645617      IF( lp_obc_north ) THEN 
    646618         IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN 
    647             IF(lwp) WRITE(numout,*) 
    648             IF(lwp) WRITE(numout,*) ' E R R O R : jpjnob exceed ', jpjglo, ' or less than 4' 
    649             IF(lwp) WRITE(numout,*) ' ========== ' 
    650             IF(lwp) WRITE(numout,*) 
    651             nstop = nstop + 1 
     619            WRITE(ctmp1,*) 'jpjnob exceed ', jpjglo, ' or less than 4' 
     620            CALL ctl_stop( ctmp1 ) 
    652621         END IF 
    653622         ztestmask(:)=0. 
    … …  
    665634      IF( lp_obc_south ) THEN 
    666635         IF( jpjsob < 2 .OR.  jpjsob >= jpjglo-2 ) THEN 
    667             IF(lwp) WRITE(numout,*) 
    668             IF(lwp) WRITE(numout,*) ' E R R O R : jpjsob exceed ', jpjglo-2, ' or less than 2' 
    669             IF(lwp) WRITE(numout,*) ' ========== ' 
    670             IF(lwp) WRITE(numout,*) 
    671             nstop = nstop + 1 
     636            WRITE(ctmp1,*) ' jpjsob exceed ', jpjglo-2, ' or less than 2' 
     637            CALL ctl_stop( ctmp1 ) 
    672638         END IF 
    673639         ztestmask(:)=0. 
    … …  
    687653         IF(lwp) WRITE(numout,*) ' ========== ' 
    688654         IF(lwp) WRITE(numout,*) 
    689          IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) THEN 
    690             IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop' 
    691             nstop = nstop + 1 
    692          END IF 
     655         IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) & 
     656              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
     657 
    693658      ELSE IF( icorner(1) == 1 ) THEN 
    694               IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at SW corner, we stop' 
    695               nstop = nstop + 1 
     659         CALL ctl_stop( ' Open boundaries do not fit at SW corner, we stop' ) 
    696660      END IF  
    697661 
    … …  
    701665          IF(lwp) WRITE(numout,*) ' ========== ' 
    702666          IF(lwp) WRITE(numout,*) 
    703           IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) THEN 
    704              IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop' 
    705              nstop = nstop + 1 
    706           END IF 
     667          IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) & 
     668               &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    707669      ELSE IF( icorner(2) == 1 ) THEN 
    708               IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at SE corner, we stop' 
    709               nstop = nstop + 1 
     670         CALL ctl_stop( ' Open boundaries do not fit at SE corner, we stop' ) 
    710671      END IF  
    711672 
    … …  
    715676         IF(lwp) WRITE(numout,*) ' ========== ' 
    716677         IF(lwp) WRITE(numout,*) 
    717          IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) THEN 
    718             IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop' 
    719             nstop = nstop + 1 
    720          END IF 
     678         IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) & 
     679              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    721680       ELSE IF( icorner(3) == 1 ) THEN 
    722                IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at NE corner, we stop' 
    723                nstop = nstop + 1 
     681          CALL ctl_stop( ' Open boundaries do not fit at NE corner, we stop' ) 
    724682       END IF  
    725683 
    … …  
    729687         IF(lwp) WRITE(numout,*) ' ========== ' 
    730688         IF(lwp) WRITE(numout,*) 
    731          IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) THEN 
    732             IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop' 
    733             nstop = nstop + 1 
    734          END IF 
     689         IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) & 
     690              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    735691       ELSE IF( icorner(4) == 1 ) THEN 
    736                IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at NW corner, we stop' 
    737                nstop = nstop + 1 
     692          CALL ctl_stop( ' Open boundaries do not fit at NW corner, we stop' ) 
    738693       END IF  
    739694 
    … …  
    792747            ! ... stop if  e r r o r (s)   detected 
    793748            IF( istop /= 0 ) THEN 
    794                IF(lwp)WRITE(numout,*) 
    795                IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 
    796                IF(lwp)WRITE(numout,*) ' =============== ' 
    797                IF(lwp)WRITE(numout,*) 
    798                nstop = nstop + 1 
     749               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
     750               CALL ctl_stop( ctmp1 ) 
    799751            ENDIF 
    800752         ENDIF 
    … …  
    821773            ! ... stop if  e r r o r (s)   detected 
    822774            IF( istop /= 0 ) THEN 
    823                IF(lwp)WRITE(numout,*) 
    824                IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 
    825                IF(lwp)WRITE(numout,*) ' =============== ' 
    826                IF(lwp)WRITE(numout,*) 
    827                nstop = nstop + 1 
     775               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
     776               CALL ctl_stop( ctmp1 ) 
    828777            ENDIF 
    829778         ENDIF 
    … …  
    850799            ! ... stop if  e r r o r (s)   detected 
    851800            IF( istop /= 0 ) THEN 
    852                IF(lwp)WRITE(numout,*) 
    853                IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 
    854                IF(lwp)WRITE(numout,*) ' =============== ' 
    855                IF(lwp)WRITE(numout,*) 
    856                nstop = nstop + 1 
    857             ENDIF 
     801                WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
     802               CALL ctl_stop( ctmp1 ) 
     803           ENDIF 
    858804         ENDIF 
    859805      ENDIF 
    … …  
    879825            ! ... stop if  e r r o r (s)   detected 
    880826            IF( istop /= 0 ) THEN 
    881                IF(lwp)WRITE(numout,*) 
    882                IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 
    883                IF(lwp)WRITE(numout,*) ' =============== ' 
    884                IF(lwp)WRITE(numout,*) 
    885                nstop = nstop + 1 
     827               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
     828               CALL ctl_stop( ctmp1 ) 
    886829            ENDIF 
    887830         ENDIF 

  • trunk/NEMO/OPA_SRC/OBC/obcrst.F90

    r367 r474  
    102102               RECL   =  nreclo,              & 
    103103               FORM   = 'UNFORMATTED' ) 
    104          IF( ios > 0 ) THEN 
    105             IF(lwp) WRITE(numout,*) '      ' 
    106             IF(lwp) WRITE(numout,*) '        Pbm to OPEN the restart.obc.output file '  
    107             IF(lwp) WRITE(numout,*) '      ' 
    108             nstop = nstop + 1    
    109          END IF 
    110  
     104         IF( ios > 0 ) CALL ctl_stop( '        Pbm to OPEN the restart.obc.output file ' ) 
     105  
    111106         ! 1.2 Write header 
    112107         ! ---------------- 
    … …  
    363358            RECL   =  nreclo,       & 
    364359            FORM   = 'UNFORMATTED' ) 
    365       IF( ios > 0 ) THEN 
    366          IF(lwp) WRITE(numout,*) '        Pbm to OPEN the restart.obc file '  
    367          nstop = nstop + 1    
    368       END IF 
     360      IF( ios > 0 ) CALL ctl_stop( '        Pbm to OPEN the restart.obc file ' ) 
    369361 
    370362      ! 1. Read 
    … …  
    385377      ! -------------------- 
    386378      IF( ( it0-it1 ) /= 1 .AND. abs(nrstdt) == 1 ) THEN 
    387           IF(lwp) THEN 
    388              WRITE(numout,*) '        ===>>>> : problem with nit000 for the restart' 
    389              WRITE(numout,*) '        ==============' 
    390              WRITE(numout,*) '        we stop in obc_rst_lec routine. Verify the file or rerun with the value' 
    391              WRITE(numout,*) '        0 for the control of time parameter nrstdt' 
    392              WRITE(numout,*) ' '  
    393           END IF 
    394           nstop = nstop + 1 
     379          CALL ctl_stop( '        ===>>>> : problem with nit000 for the restart',   & 
     380               &         '        ==============',   & 
     381               &         '        we stop in obc_rst_lec routine. Verify the file or rerun with the value',   & 
     382               &         '        0 for the control of time parameter nrstdt' ) 
     383              
    395384      END IF 
    396385  
    … …  
    411400            WRITE(numout,*) '         ' 
    412401            WRITE(numout,*) '        East open boundary' 
    413             IF( jpieob0 /= jpieob1 ) THEN 
    414                WRITE(numout,*) '         ==>>>> : Problem in obc_rst_lec, jpieob have changed' 
    415                nstop = nstop + 1 
    416             END IF 
     402            IF( jpieob0 /= jpieob1 ) CALL ctl_stop( '         ==>>>> : Problem in obc_rst_lec, jpieob have changed' ) 
    417403         END IF 
    418404      END IF 
    … …  
    422408            WRITE(numout,*) '         ' 
    423409            WRITE(numout,*) '        West open boundary' 
    424             IF( jpiwob0 /= jpiwob1 ) THEN 
    425                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpiwob has changed' 
    426                nstop = nstop + 1 
    427             END IF 
     410            IF( jpiwob0 /= jpiwob1 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpiwob has changed' ) 
    428411         END IF 
    429412      END IF 
    … …  
    433416            WRITE(numout,*) '         ' 
    434417            WRITE(numout,*) '        North open boundary' 
    435             IF( jpjnob0 /= jpjnob1 ) THEN 
    436                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjnob has changed' 
    437                nstop = nstop + 1 
    438             END IF 
     418            IF( jpjnob0 /= jpjnob1 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjnob has changed' ) 
    439419         END IF 
    440420      END IF 
    … …  
    444424            WRITE(numout,*) '         ' 
    445425            WRITE(numout,*) '        South open boundary' 
    446             IF( jpjsob0 /= jpjsob1) THEN 
    447                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjsob has changed' 
    448                nstop = nstop + 1 
    449             END IF 
     426            IF( jpjsob0 /= jpjsob1) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjsob has changed' ) 
    450427         END IF 
    451428      END IF 
    … …  
    455432      ! ------------------------------------------ 
    456433      IF( lp_obc_east .AND. ( jpieob1 /= 0 ) ) THEN 
    457          IF(lwp) THEN 
    458             IF( ied1 /= ied0 ) THEN 
    459                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjed has changed' 
    460                nstop = nstop + 1 
    461             END IF 
    462             IF( ief1 /= ief0 ) THEN 
    463                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjef has changed' 
    464                nstop = nstop + 1 
    465             END IF 
    466          END IF 
     434         IF( ied1 /= ied0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjed has changed' ) 
     435         IF( ief1 /= ief0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjef has changed' ) 
    467436      END IF 
    468437 
    469438      IF( lp_obc_west .AND. ( jpiwob1 /= 0 ) ) THEN 
    470          IF(lwp) THEN 
    471             IF( iwd1 /= iwd0 ) THEN 
    472                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjwd has changed' 
    473                nstop = nstop + 1 
    474             END IF 
    475             IF( iwf1 /= iwf0 ) THEN 
    476                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjwf has changed' 
    477                nstop = nstop + 1 
    478             END IF 
    479          END IF 
     439         IF( iwd1 /= iwd0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjwd has changed' ) 
     440         IF( iwf1 /= iwf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjwf has changed' ) 
    480441      END IF 
    481442  
    482443      IF( lp_obc_north .AND. ( jpjnob1 /= 0 ) ) THEN 
    483          IF(lwp) THEN 
    484             IF( ind1 /= ind0 ) THEN 
    485                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpind has changed' 
    486                nstop = nstop + 1 
    487             END IF 
    488             IF( inf1 /= inf0 ) THEN 
    489                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpinf has changed' 
    490                nstop = nstop + 1 
    491              END IF 
    492           END IF 
     444         IF( ind1 /= ind0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpind has changed' ) 
     445         IF( inf1 /= inf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpinf has changed' ) 
    493446      END IF 
    494447  
    495448      IF( lp_obc_south .AND. ( jpjsob1 /= 0 ) ) THEN 
    496          IF(lwp) THEN 
    497             IF( isd1 /= isd0 ) THEN 
    498                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpisd has changed' 
    499                nstop = nstop + 1 
    500             END IF 
    501             IF( isf1 /= isf0 ) THEN 
    502                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpisf has changed' 
    503                nstop = nstop + 1 
    504             END IF 
    505          END IF 
     449         IF( isd1 /= isd0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpisd has changed' ) 
     450         IF( isf1 /= isf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpisf has changed' ) 
    506451      END IF 
    507452  

  • trunk/NEMO/OPA_SRC/SBC/flxfwb.F90

    r359 r474  
    297297            IF(lwp)WRITE(numout,*)'               year = ',iyear-2, ' freshwater budget read       = ', a_fwb_b 
    298298         ELSE 
    299             IF(lwp) WRITE(numout,*) 
    300             IF(lwp) WRITE(numout,*)'flx_fwb_init : unable to read the file', clname 
    301             nstop = nstop + 1 
     299            WRITE(ctmp1,*)'flx_fwb_init : unable to read the file', clname 
     300            CALL ctl_stop( ctmp1 ) 
    302301         ENDIF 
    303302         !                                    ! ============================== 

  • trunk/NEMO/OPA_SRC/SOL/solver.F90

    r413 r474  
    133133         IF(lwp) WRITE(numout,*) 
    134134         IF(lwp) WRITE(numout,*) '          free surface formulation' 
    135          IF( lk_isl ) THEN 
    136             IF(lwp) WRITE(numout,cform_err) 
    137             IF(lwp) WRITE(numout,*) ' key_islands inconsistent with key_dynspg_flt' 
    138             nstop = nstop + 1 
    139          ENDIF 
     135         IF( lk_isl ) CALL ctl_stop( ' key_islands inconsistent with key_dynspg_flt' ) 
     136     
    140137      ELSEIF( lk_dynspg_rl ) THEN 
    141138         IF(lwp) WRITE(numout,*) 
    142139         IF(lwp) WRITE(numout,*) '          Rigid lid formulation' 
    143140      ELSE 
    144          IF(lwp) WRITE(numout,cform_err) 
    145          IF(lwp) WRITE(numout,*) '          Choose only one surface pressure gradient calculation: filtered or rigid-lid' 
    146          IF(lwp) WRITE(numout,*) '          Should not call this routine if dynspg_exp or dynspg_ts has been chosen' 
    147          nstop = nstop + 1 
    148       ENDIF 
    149       IF( lk_dynspg_flt .AND. lk_dynspg_rl ) THEN 
    150          IF(lwp) WRITE(numout,cform_err) 
    151          IF(lwp) WRITE(numout,*) '          Chose between free surface or rigid-lid, not both' 
    152          nstop = nstop + 1 
    153       ENDIF 
     141         CALL ctl_stop( '          Choose only one surface pressure gradient calculation: filtered or rigid-lid',   & 
     142              &         '          Should not call this routine if dynspg_exp or dynspg_ts has been chosen' ) 
     143      ENDIF 
     144      IF( lk_dynspg_flt .AND. lk_dynspg_rl ) & 
     145         CALL ctl_stop( '          Chose between free surface or rigid-lid, not both' ) 
    154146 
    155147      SELECT CASE ( nsolv ) 
    … …  
    157149      CASE ( 1 )                ! preconditioned conjugate gradient solver 
    158150         IF(lwp) WRITE(numout,*) '          a preconditioned conjugate gradient solver is used' 
    159          IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 
    160             IF(lwp) WRITE(numout,cform_err) 
    161             IF(lwp) WRITE(numout,*) ' jpr2di and jpr2dj should be equal to zero' 
    162             nstop = nstop + 1 
    163          ENDIF 
     151         IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) & 
     152            CALL ctl_stop( ' jpr2di and jpr2dj should be equal to zero' ) 
    164153 
    165154      CASE ( 2 )                ! successive-over-relaxation solver 
    166155         IF(lwp) WRITE(numout,*) '          a successive-over-relaxation solver is used' 
    167          IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 
    168             IF(lwp) WRITE(numout,cform_err) 
    169             IF(lwp) WRITE(numout,*) ' jpr2di and jpr2dj should be equal to zero' 
    170             nstop = nstop + 1 
    171          ENDIF 
     156         IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) & 
     157             CALL ctl_stop( ' jpr2di and jpr2dj should be equal to zero' ) 
    172158 
    173159      CASE ( 3 )                ! FETI solver 
    174160         IF(lwp) WRITE(numout,*) '          the FETI solver is used' 
    175          IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 
    176             IF(lwp) WRITE(numout,cform_err) 
    177             IF(lwp) WRITE(numout,*) ' jpr2di and jpr2dj should be equal to zero' 
    178             nstop = nstop + 1 
    179          ENDIF 
     161         IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) & 
     162              CALL ctl_stop( ' jpr2di and jpr2dj should be equal to zero' ) 
     163            
    180164         IF( .NOT.lk_mpp ) THEN 
    181             IF(lwp) WRITE(numout,cform_err) 
    182             IF(lwp) WRITE(numout,*) ' The FETI algorithm is used only with the key_mpp_... option' 
    183             nstop = nstop + 1 
     165            CALL ctl_stop( ' The FETI algorithm is used only with the key_mpp_... option' ) 
    184166         ELSE 
    185167            IF( jpnij == 1 ) THEN 
    186                IF(lwp) WRITE(numout,cform_err) 
    187                IF(lwp) WRITE(numout,*) ' The FETI algorithm needs more than one processor' 
    188                nstop = nstop + 1 
     168               CALL ctl_stop( ' The FETI algorithm needs more than one processor' ) 
    189169            ENDIF 
    190170         ENDIF 
    … …  
    194174         IF(lwp) WRITE(numout,*) '          with jpr2di =', jpr2di, ' and  jpr2dj =', jpr2dj 
    195175         IF( .NOT. lk_mpp .AND. jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 
    196             IF(lwp) WRITE(numout,cform_err) 
    197             IF(lwp) WRITE(numout,*) ' jpr2di and jpr2dj are not equal to zero' 
    198             IF(lwp) WRITE(numout,*) ' In this case this algorithm should be used only with the key_mpp_... option' 
    199             nstop = nstop + 1 
     176             CALL ctl_stop( ' jpr2di and jpr2dj are not equal to zero',   & 
     177             &              ' In this case this algorithm should be used only with the key_mpp_... option' ) 
    200178         ELSE 
    201179            IF( ( ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) .OR. ( jpni /= 1 ) ) & 
    202               &  .AND. ( jpr2di /= jpr2dj ) ) THEN   
    203                IF(lwp) WRITE(numout,cform_err) 
    204                IF(lwp) WRITE(numout,*) '          jpr2di should be equal to jpr2dj' 
    205                nstop = nstop + 1 
    206             ENDIF 
     180              &  .AND. ( jpr2di /= jpr2dj ) ) CALL ctl_stop( '          jpr2di should be equal to jpr2dj' ) 
    207181         ENDIF 
    208182 
    209183      CASE DEFAULT 
    210          IF(lwp) WRITE(numout,cform_err) 
    211          IF(lwp) WRITE(numout,*) '          bad flag value for nsolv = ', nsolv 
    212          nstop = nstop + 1 
     184         WRITE(ctmp1,*) '          bad flag value for nsolv = ', nsolv 
     185         CALL ctl_stop( ctmp1 ) 
    213186          
    214187      END SELECT 
    … …  
    244217 
    245218         IF ( jpisl == 0 ) THEN 
    246              IF(lwp)WRITE(numout,cform_err) 
    247              IF(lwp)WRITE(numout,*) ' bad islands parameter jpisl =', jpisl 
    248              nstop = nstop + 1 
     219             WRITE(ctmp1,*) ' bad islands parameter jpisl =', jpisl 
     220             CALL ctl_stop( ctmp1 ) 
    249221         ENDIF 
    250222 

  • trunk/NEMO/OPA_SRC/TRA/traadv.F90

    r458 r474  
    166166      IF( ln_traadv_muscl2 )   ioptio = ioptio + 1 
    167167 
    168       IF( .NOT.lk_esopa .AND. ( ioptio > 1 .OR. ioptio == 0 ) ) THEN 
    169          IF(lwp) WRITE(numout,cform_err) 
    170          IF(lwp) WRITE(numout,*) ' Choose ONE advection scheme in namelist nam_traadv' 
    171          nstop = nstop + 1 
    172       ENDIF 
     168      IF( .NOT.lk_esopa .AND. ( ioptio > 1 .OR. ioptio == 0 ) ) & 
     169           &   CALL ctl_stop( ' Choose ONE advection scheme in namelist nam_traadv' ) 
    173170 
    174       IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) THEN 
    175          IF(lwp) WRITE(numout,cform_err) 
    176          IF(lwp) WRITE(numout,*) '     cross-land advection only with 2nd order advection scheme' 
    177          nstop = nstop + 1 
    178       ENDIF 
     171      IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) & 
     172           &   CALL ctl_stop( '     cross-land advection only with 2nd order advection scheme' ) 
    179173 
    180174      ! Set nadv 

  • trunk/NEMO/OPA_SRC/TRA/traadv_ctl.F90

    r359 r474  
    8585         ln_traadv_muscl2 = .TRUE. 
    8686      ELSEIF( ioptio > 1 .OR. ioptio == 0 ) THEN 
    87          IF(lwp) WRITE(numout,cform_err) 
    88          IF(lwp) WRITE(numout,*) ' Choose one advection scheme in namelist nam_traadv' 
    89          IF(lwp) WRITE(numout,*) '        ***                              ***********' 
    90          nstop = nstop + 1 
     87         CALL ctl_stop( ' Choose one advection scheme in namelist nam_traadv', & 
     88              &         '        ***                              ***********' ) 
    9189      ENDIF 
    9290 
    93       IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) THEN 
    94          IF(lwp) WRITE(numout,cform_err) 
    95          IF(lwp) WRITE(numout,*) '     cross-land advection only with 2nd order advection scheme' 
    96          nstop = nstop + 1 
    97       ENDIF 
     91      IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) & 
     92           &   CALL ctl_stop( '     cross-land advection only with 2nd order advection scheme' ) 
    9893 
    9994   END SUBROUTINE tra_adv_ctl 

  • trunk/NEMO/OPA_SRC/TRA/trabbl.F90

    r457 r474  
    321321      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    322322 
    323          IF(lwp) WRITE(numout,cform_err) 
    324          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    325          IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it ' 
    326          nstop = nstop + 1 
     323         CALL ctl_stop( '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )', & 
     324              &         '          bbl not implented: easy to do it ' ) 
    327325 
    328326      CASE DEFAULT 
    329327 
    330          IF(lwp) WRITE(numout,cform_err) 
    331          IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
    332          nstop = nstop + 1 
     328         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     329         CALL ctl_stop(ctmp1) 
    333330 
    334331      END SELECT 

  • trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90

    r457 r474  
    237237      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    238238 
    239          IF(lwp) WRITE(numout,cform_err) 
    240          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    241          IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it ' 
    242          nstop = nstop + 1 
     239         CALL ctl_stop( '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )', & 
     240              &         '          bbl not implented: easy to do it ' ) 
    243241 
    244242      CASE DEFAULT 
    245243 
    246          IF(lwp) WRITE(numout,cform_err) 
    247          IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
    248          nstop = nstop + 1 
     244         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     245         CALL ctl_stop( ctmp1 ) 
    249246 
    250247      END SELECT 

  • trunk/NEMO/OPA_SRC/TRA/traldf.F90

    r458 r474  
    168168      IF( ln_traldf_lap   )   ioptio = ioptio + 1 
    169169      IF( ln_traldf_bilap )   ioptio = ioptio + 1 
    170       IF( ioptio /= 1 )   THEN 
    171           IF(lwp) WRITE(numout,cform_err) 
    172           IF(lwp) WRITE(numout,*) '          use ONE of the 2 lap/bilap operator type on tracer' 
    173           nstop = nstop + 1 
    174       ENDIF 
     170      IF( ioptio /= 1 ) CALL ctl_stop( '          use ONE of the 2 lap/bilap operator type on tracer' ) 
    175171      ioptio = 0 
    176172      IF( ln_traldf_level )   ioptio = ioptio + 1 
    177173      IF( ln_traldf_hor   )   ioptio = ioptio + 1 
    178174      IF( ln_traldf_iso   )   ioptio = ioptio + 1 
    179       IF( ioptio /= 1 ) THEN 
    180          IF(lwp) WRITE(numout,cform_err) 
    181          IF(lwp) WRITE(numout,*) '          use only ONE direction (level/hor/iso)' 
    182          nstop = nstop + 1 
    183       ENDIF 
     175      IF( ioptio /= 1 ) CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
    184176 
    185177      ! defined the type of lateral diffusion from ln_traldf_... logicals 
    … …  
    221213      ENDIF 
    222214 
    223       IF( ierr == 1 ) THEN 
    224          IF(lwp) WRITE(numout,cform_err) 
    225          IF(lwp) WRITE(numout,*) ' iso-level in z-coordinate - partial step, not allowed' 
    226          nstop = nstop + 1 
    227       ENDIF 
    228       IF( ierr == 2 ) THEN 
    229          IF(lwp) WRITE(numout,cform_err) 
    230          IF(lwp) WRITE(numout,*) ' isoneutral bilaplacian operator does not exist' 
    231          nstop = nstop + 1 
    232       ENDIF 
    233       IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso ) THEN 
    234          IF(lwp) WRITE(numout,*) '          eddy induced velocity on tracers' 
    235          IF(lwp) WRITE(numout,cform_err) 
    236          IF(lwp) WRITE(numout,*) ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' 
    237          nstop = nstop + 1 
    238       ENDIF 
     215      IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
     216      IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
     217      IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso ) & 
     218           & CALL ctl_stop( '          eddy induced velocity on tracers', & 
     219           &                ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    239220      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    240          IF( .NOT.lk_ldfslp ) THEN 
    241             IF(lwp) WRITE(numout,cform_err) 
    242             IF(lwp) WRITE(numout,*) '          the rotation of the diffusive tensor require key_ldfslp' 
    243             nstop = nstop + 1 
    244          ENDIF 
     221         IF( .NOT.lk_ldfslp ) CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' ) 
    245222      ENDIF 
    246223 
    … …  
    320297      va    (:,:,:) = sa (:,:,:) 
    321298      zavt  (:,:,:) = avt(:,:,:) 
    322       IF( lk_zdfddm ) THEN 
    323           IF(lwp) WRITE(numout,cform_err) 
    324           IF(lwp) WRITE(numout,*) ' key_traldf_ano with key_zdfddm not implemented' 
    325           nstop = nstop + 1 
    326       ENDIF 
     299      IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' ) 
    327300      ! set tb, sb to reference values and avr to zero 
    328301      tb (:,:,:) = zt_ref(:,:,:) 

  • trunk/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r457 r474  
    9090      REAL(wp) ::   zta, zsa              ! temporary scalars 
    9191      REAL(wp), DIMENSION(jpi,jpj) ::   &  
    92          zeeu, zeev, zbtr,              & ! 2D workspace 
    93          zlt, zls 
     92         zeeu, zeev, zbtr                 ! 2D workspace arrays 
    9493      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  
    95          zsu, zsv                         ! 3D workspace  
     94         zsu, zsv, zlt, zls               ! 3D workspace arrays 
    9695      !!---------------------------------------------------------------------- 
    9796 
    … …  
    101100         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 
    102101      ENDIF 
    103  
    104102 
    105103      !                                                ! =============== 
    … …  
    162160         DO jj = 2, jpjm1 
    163161            DO ji = fs_2, fs_jpim1   ! vector opt. 
    164                zlt(ji,jj) = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    165                zls(ji,jj) = zbtr(ji,jj) * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) 
     162               zlt(ji,jj,jk) = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
     163               zls(ji,jj,jk) = zbtr(ji,jj) * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) 
    166164            END DO 
    167165         END DO 
    … …  
    170168         DO jj = 2, jpjm1 
    171169            DO ji = fs_2, fs_jpim1   ! vector opt. 
    172                zlt(ji,jj) = fsahtt(ji,jj,jk) * zlt(ji,jj) 
    173                zls(ji,jj) = fsahtt(ji,jj,jk) * zls(ji,jj) 
    174             END DO 
    175          END DO 
    176  
    177          ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn) 
    178          CALL lbc_lnk( zlt, 'T', 1. )   ;    CALL lbc_lnk( zls, 'T', 1. ) 
    179  
     170               zlt(ji,jj,jk) = fsahtt(ji,jj,jk) * zlt(ji,jj,jk) 
     171               zls(ji,jj,jk) = fsahtt(ji,jj,jk) * zls(ji,jj,jk) 
     172            END DO 
     173         END DO 
     174      ENDDO 
     175 
     176      ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn) 
     177      CALL lbc_lnk( zlt, 'T', 1. )   ;    CALL lbc_lnk( zls, 'T', 1. ) 
     178 
     179      DO jk = 1, jpkm1 
     180       
    180181         ! 2. Bilaplacian 
    181182         ! -------------- 
    … …  
    184185         DO jj = 1, jpjm1 
    185186            DO ji = 1, fs_jpim1   ! vector opt. 
    186                ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) ) 
    187                zsu(ji,jj,jk) = zeeu(ji,jj) * ( zls(ji+1,jj  ) - zls(ji,jj) ) 
    188                ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) ) 
    189                zsv(ji,jj,jk) = zeev(ji,jj) * ( zls(ji  ,jj+1) - zls(ji,jj) ) 
     187               ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ,jk) - zlt(ji,jj,jk) ) 
     188               zsu(ji,jj,jk) = zeeu(ji,jj) * ( zls(ji+1,jj  ,jk) - zls(ji,jj,jk) ) 
     189               ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1,jk) - zlt(ji,jj,jk) ) 
     190               zsv(ji,jj,jk) = zeev(ji,jj) * ( zls(ji  ,jj+1,jk) - zls(ji,jj,jk) ) 
    190191            END DO 
    191192         END DO 

  • trunk/NEMO/OPA_SRC/TRA/traqsr.F90

    r457 r474  
    245245      ENDIF 
    246246 
    247       IF( rabs > 1.e0 .OR. rabs < 0.e0 .OR. xsi1 < 0.e0 .OR. xsi2 < 0.e0 ) THEN 
    248          IF(lwp) WRITE(numout,cform_err) 
    249          IF(lwp) WRITE(numout,*) '             0<rabs<1, 0<xsi1, or 0<xsi2 not satisfied' 
    250          nstop = nstop + 1 
    251       ENDIF 
    252  
     247      IF( rabs > 1.e0 .OR. rabs < 0.e0 .OR. xsi1 < 0.e0 .OR. xsi2 < 0.e0 ) & 
     248         CALL ctl_stop( '             0<rabs<1, 0<xsi1, or 0<xsi2 not satisfied' ) 
    253249 
    254250      ! Initialization of gdsr 

  • trunk/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r463 r474  
    225225 
    226226      CASE DEFAULT 
    227          IF(lwp) WRITE(numout,cform_err) 
    228          IF(lwp) WRITE(numout,*) '         bad flag value for nbotfr = ', nbotfr 
    229          nstop = nstop + 1 
     227         WRITE(ctmp1,*) '         bad flag value for nbotfr = ', nbotfr 
     228         CALL ctl_stop( ctmp1 ) 
    230229 
    231230      END SELECT 

  • trunk/NEMO/OPA_SRC/ZDF/zdfini.F90

    r463 r474  
    105105         ioptio = ioptio+1 
    106106      ENDIF 
    107       IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa ) THEN 
    108           IF(lwp) WRITE(numout,cform_err) 
    109           IF(lwp) WRITE(numout,*) ' one and only one vertical diffusion option has to be defined ' 
    110           nstop = nstop + 1 
    111       ENDIF 
     107      IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa ) & 
     108         CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' ) 
    112109 
    113110      ! ... Convection 
    … …  
    133130         ENDIF 
    134131      ENDIF 
    135       IF ( ioptio > 1 .AND. .NOT. lk_esopa ) THEN 
    136           IF(lwp) WRITE(numout,cform_err) 
    137           IF(lwp) WRITE(numout,*) ' chose between ln_zdfnpc' 
    138           IF(lwp) WRITE(numout,*) '           and ln_zdfevd' 
    139           nstop = nstop + 1 
    140       ENDIF 
    141       IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfkpp ) ) THEN 
    142          IF(lwp) WRITE(numout,cform_err) 
    143          IF(lwp) WRITE(numout,*) ' except for TKE sor KPP physics, a convection scheme is' 
    144          IF(lwp) WRITE(numout,*) ' required: ln_zdfevd or ln_zdfnpc logicals' 
    145          nstop = nstop + 1 
    146       ENDIF 
     132      IF ( ioptio > 1 .AND. .NOT. lk_esopa ) & 
     133           CALL ctl_stop( ' chose between ln_zdfnpc', '           and ln_zdfevd' ) 
     134      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfkpp ) ) & 
     135         CALL ctl_stop( ' except for TKE sor KPP physics, a convection scheme is', & 
     136         &              ' required: ln_zdfevd or ln_zdfnpc logicals' ) 
    147137 
    148138   END SUBROUTINE zdf_init 

  • trunk/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r463 r474  
    15051505 
    15061506      CASE DEFAULT 
    1507          IF(lwp) WRITE(numout,cform_err) 
    1508          IF(lwp) WRITE(numout,*) '          bad flag value for nave = ', nave 
    1509          nstop = nstop + 1 
     1507         WRITE(ctmp1,*) '          bad flag value for nave = ', nave 
     1508         CALL ctl_opa( ctmp1 ) 
    15101509 
    15111510      END SELECT 

  • trunk/NEMO/OPA_SRC/ZDF/zdftke.F90

    r463 r474  
    680680 
    681681      ! Check nmxl and npdl values 
    682       IF( nmxl < 0 .OR. nmxl > 3 ) THEN 
    683          IF(lwp) WRITE(numout,cform_err) 
    684          IF(lwp) WRITE(numout,*) '          bad flag: nmxl is < 0 or > 3 ' 
    685          nstop = nstop + 1 
    686       ENDIF 
    687       IF ( npdl < 0 .OR. npdl > 1 ) THEN 
    688          IF(lwp) WRITE(numout,cform_err) 
    689          IF(lwp) WRITE(numout,*) '          bad flag: npdl is < 0 or > 1 ' 
    690          nstop = nstop + 1 
    691       ENDIF 
    692  
     682      IF( nmxl < 0 .OR. nmxl > 3 ) CALL ctl_stop( '          bad flag: nmxl is < 0 or > 3 ' ) 
     683      IF ( npdl < 0 .OR. npdl > 1 ) CALL ctl_stop( '          bad flag: npdl is < 0 or > 1 ' ) 
    693684 
    694685      ! Horizontal average : initialization of weighting arrays  
    … …  
    761752 
    762753      CASE DEFAULT 
    763          IF(lwp) WRITE(numout,cform_err) 
    764          IF(lwp) WRITE(numout,*) '          bad flag value for nave = ', nave 
    765          nstop = nstop + 1 
     754         WRITE(ctmp1,*) '          bad flag value for nave = ', nave 
     755         CALL ctl_stop( ctmp1 ) 
    766756 
    767757      END SELECT 

  • trunk/NEMO/OPA_SRC/eosbn2.F90

    r467 r474  
    219219      CASE DEFAULT 
    220220 
    221          IF(lwp) WRITE(numout,cform_err) 
    222          IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
    223          nstop = nstop + 1 
     221         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     222         CALL ctl_stop( ctmp1 ) 
    224223 
    225224      END SELECT 
    … …  
    407406      CASE DEFAULT 
    408407 
    409          IF(lwp) WRITE(numout,cform_err) 
    410          IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
    411          nstop = nstop + 1 
     408         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     409         CALL ctl_stop( ctmp1 ) 
    412410 
    413411      END SELECT 
    … …  
    586584      CASE DEFAULT 
    587585 
    588          IF(lwp) WRITE(numout,cform_err) 
    589          IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
    590          nstop = nstop + 1 
     586         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     587         CALL ctl_stop( ctmp1 ) 
    591588 
    592589      END SELECT 
    … …  
    761758      CASE DEFAULT 
    762759 
    763          IF(lwp) WRITE(numout,cform_err) 
    764          IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
    765          nstop = nstop + 1 
     760         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     761         CALL ctl_stop( ctmp1 ) 
    766762 
    767763      END SELECT 
    … …  
    827823 
    828824         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )' 
    829          IF( lk_zdfddm ) THEN 
    830             IF(lwp) WRITE(numout,cform_err) 
    831             IF(lwp) WRITE(numout,*) '          double diffusive mixing parameterization requires',   & 
    832                                              ' that T and S are used as state variables' 
    833             nstop = nstop + 1 
    834          ENDIF 
     825         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   & 
     826              &                         ' that T and S are used as state variables' ) 
    835827 
    836828      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    … …  
    840832      CASE DEFAULT 
    841833 
    842          IF(lwp) WRITE(numout,cform_err) 
    843          IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos 
    844          nstop = nstop + 1 
     834         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     835         CALL ctl_stop( ctmp1 ) 
    845836 
    846837      END SELECT 

  • trunk/NEMO/OPA_SRC/geo2ocean.F90

    r247 r474  
    255255 
    256256         CASE default 
    257             IF(lwp) WRITE(numout,cform_err) 
    258             IF(lwp) WRITE(numout,*) 'geo2oce : bad grid argument : ', cgrid 
    259             nstop = nstop + 1 
     257            WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 
     258            CALL ctl_stop( ctmp1 ) 
    260259       END SELECT 
    261260       
    … …  
    327326      IF( kchoix == 0 ) THEN 
    328327         IF( nmem == 0 ) THEN 
    329             IF(lwp) WRITE(numout,cform_err) 
    330             IF(lwp) WRITE(numout,*) 'repere : e r r o r  in kchoix : ', kchoix 
    331             IF(lwp) WRITE(numout,*) ' for the first call , you must indicate ' 
    332             IF(lwp) WRITE(numout,*) ' the direction of change ' 
    333             IF(lwp) WRITE(numout,*) ' kchoix = 1 geo       --> stretched ' 
    334             IF(lwp) WRITE(numout,*) ' kchoix =-1 stretched --> geo ' 
    335             nstop = nstop + 1 
     328            WRITE(ctmp1,*) 'repere : e r r o r  in kchoix : ', kchoix 
     329            CALL ctl_stop( ctmp1, ' for the first call , you must indicate ',   & 
     330                 &                ' the direction of change ',   & 
     331                 &                ' kchoix = 1 geo       --> stretched ',   & 
     332                 &                ' kchoix =-1 stretched --> geo ' ) 
    336333         ELSE 
    337334            kchoix = nmem 
    … …  
    340337         nmem = kchoix 
    341338      ELSE 
    342          IF(lwp) WRITE(numout,cform_err) 
    343          IF(lwp) WRITE(numout,*) 'repere : e r r o r  in kchoix : ', kchoix 
    344          IF(lwp) WRITE(numout,*) ' kchoix must be equal to -1, 0 or 1 ' 
    345          nstop = nstop + 1 
     339         WRITE(ctmp1,*) 'repere : e r r o r  in kchoix : ', kchoix 
     340         CALL ctl_stop( ctmp1, ' kchoix must be equal to -1, 0 or 1 ' ) 
    346341      ENDIF 
    347342 

  • trunk/NEMO/OPA_SRC/mppini.F90

    r434 r474  
    7777      ENDIF 
    7878 
    79       IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) THEN 
    80           IF(lwp)WRITE(numout,cform_err) 
    81           IF(lwp)WRITE(numout,*) 'equality  jpni = jpnj = jpnij = 1 is not satisfied' 
    82           IF(lwp)WRITE(numout,*) 'the domain is lay out for distributed memory computing! ' 
    83           nstop = nstop + 1 
    84       ENDIF 
    85  
     79      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) & 
     80          CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   & 
     81          &              'the domain is lay out for distributed memory computing! ' ) 
    8682 
    8783   END SUBROUTINE mpp_init 
    … …  
    467463      ENDIF 
    468464 
    469       IF( nperio == 1 .AND. jpni /= 1 )THEN 
    470          IF(lwp) WRITE(numout,cform_err) 
    471          IF(lwp) WRITE(numout,*) ' mpp_init: error on cyclicity' 
    472          nstop = nstop + 1 
    473       ENDIF 
     465      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 
    474466 
    475467      ! Prepare mpp north fold 

  • trunk/NEMO/OPA_SRC/step.F90

    r467 r474  
    405405      !                                            ! Time loop: control and print 
    406406                       CALL stp_ctl( kstp, indic ) 
    407                        IF ( indic < 0 )   nstop = nstop + 1 
     407                       IF ( indic < 0 ) CALL ctl_stop( 'step: indic < 0' )  
    408408 
    409409      IF ( nstop == 0 ) THEN 
Note: See TracChangeset for help on using the changeset viewer.