- Timestamp:
- 2006-05-11T17:24:19+02:00 (18 years ago)
- Location:
- trunk/NEMO
- Files:
-
- 39 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/C1D_SRC/step1d.F90
r468 r474 266 266 ! ! Time loop: control and print 267 267 CALL stp_ctl( kstp, indic ) 268 IF ( indic < 0 ) nstop = nstop + 1268 IF ( indic < 0 ) CALL ctl_stop( 'step1d: indic < 0' ) 269 269 270 270 IF ( nstop == 0 ) THEN -
trunk/NEMO/LIM_SRC/limistate.F90
r419 r474 327 327 328 328 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 ) 332 331 ENDIF 333 332 ENDIF -
trunk/NEMO/LIM_SRC/limrst_dimg.h90
r391 r474 191 191 192 192 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' ) 200 196 ENDIF 201 197 -
trunk/NEMO/OPA_SRC/DIA/diafwb.F90
r407 r474 198 198 CASE DEFAULT ! ORCA R05 or R025 199 199 ! ! ======================= 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' ) 203 201 ! 204 202 END SELECT … … 242 240 CASE DEFAULT ! ORCA R05 or R025 243 241 ! ! ======================= 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' ) 247 243 ! 248 244 END SELECT … … 286 282 CASE DEFAULT ! ORCA R05 or R025 287 283 ! ! ======================= 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' ) 291 285 ! 292 286 END SELECT … … 330 324 CASE DEFAULT ! ORCA R05 or R025 331 325 ! ! ======================= 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' ) 335 327 ! 336 328 END SELECT -
trunk/NEMO/OPA_SRC/DIA/diahdy.F90
r460 r474 107 107 IF(lwp) WRITE(numout,*) 'dia_hdy : computation of dynamical heigh' 108 108 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' ) 114 111 DO jk = 1, jpk 115 112 IF( gdepw_0(jk) > zgdsup ) GOTO 110 -
trunk/NEMO/OPA_SRC/DIA/diaspr.F90
r359 r474 142 142 ! control 143 143 # 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 !!' ) 147 145 # endif 148 146 -
trunk/NEMO/OPA_SRC/DOM/domcfg.F90
r434 r474 65 65 ' north fold with F-point pivot' 66 66 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' ) 73 68 74 69 ! global domain versus zoom and/or local domain … … 161 156 ! zoom control 162 157 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 ! ' ) 168 160 169 161 ! set zoom flag … … 185 177 WRITE(numout,*) ' lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)' 186 178 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' ) 202 184 203 185 ! Pre-defined arctic/antarctic zoom of ORCA configuration flag -
trunk/NEMO/OPA_SRC/DOM/dommsk.F90
r454 r474 152 152 IF(lwp) WRITE(numout,*) ' ocean lateral strong-slip ' 153 153 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 ) 157 156 ENDIF 158 157 … … 507 506 IF(lwp)WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 508 507 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' ) 514 509 515 510 ! mask for second order calculation of vorticity … … 606 601 IF( npcoa(1,jk) > itest .OR. npcoa(2,jk) > itest .OR. & 607 602 npcoa(3,jk) > itest .OR. npcoa(4,jk) > itest ) THEN 608 WRITE(numout,*)609 WRITE( numout,*) ' level jk = ',jk610 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), & 612 607 & npcoa(3,jk), npcoa(4,jk) 613 WRITE( numout,*) ' 2*(jpi+jpj) = ',itest,'. we stop.'614 STOP !!bug nstop to be used608 WRITE(ctmp4,*) ' 2*(jpi+jpj) = ',itest,'. we stop.' 609 CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4 ) 615 610 ENDIF 616 611 END DO … … 664 659 & ' Point(',icoord(jl,1),',',icoord(jl,2),')' 665 660 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...' ) 668 662 ENDIF 669 663 -
trunk/NEMO/OPA_SRC/DOM/domstp.F90
r454 r474 88 88 IF(lwp) WRITE(numout,*)' accelerating the convergence' 89 89 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' ) 96 92 IF(lwp) WRITE(numout,*)' tracers time step : dt (hours) level' 97 93 … … 108 104 CASE DEFAULT ! E R R O R 109 105 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 ) 114 108 115 109 END SELECT -
trunk/NEMO/OPA_SRC/DYN/dynhpg.F90
r455 r474 203 203 IF( ln_hpg_djc ) ioptio = ioptio + 1 204 204 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' ) 210 207 211 208 IF( lk_dynhpg_jki ) THEN -
trunk/NEMO/OPA_SRC/DYN/dynldf.F90
r456 r474 152 152 IF( ln_dynldf_lap ) ioptio = ioptio + 1 153 153 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' ) 159 155 ioptio = 0 160 156 IF( ln_dynldf_level ) ioptio = ioptio + 1 161 157 IF( ln_dynldf_hor ) ioptio = ioptio + 1 162 158 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)' ) 168 160 169 161 ! defined the type of lateral diffusion from ln_dynldf_... logicals … … 205 197 ENDIF 206 198 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' ) 217 203 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' ) 223 206 ENDIF 224 207 -
trunk/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r455 r474 86 86 REAL(wp) :: zua, zva, zbt, ze2u, ze2v ! temporary scalar 87 87 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 89 91 !!---------------------------------------------------------------------- 90 92 !! OPA 8.5, LODYC-IPSL (2002) … … 96 98 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 97 99 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 102 110 103 111 ! ! =============== … … 108 116 109 117 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) 111 119 DO jj = 2, jpjm1 112 120 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) ) & 114 122 & + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj) 115 123 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) ) & 117 125 & + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj) 118 126 END DO … … 121 129 DO jj = 2, jpjm1 122 130 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) & 124 132 & + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj ,jk) ) / e1u(ji,jj) 125 133 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) & 127 135 & + ( hdivb(ji,jj+1,jk) - hdivb(ji ,jj,jk) ) / e2v(ji,jj) 128 136 END DO 129 137 END DO 130 138 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 137 148 ! Third derivative 138 149 ! ---------------- 139 150 140 151 ! 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) 143 154 144 155 ! Contravariant "laplacian" 145 zcu(:,:) = e1u(:,:) * zlu(:,: )146 zcv(:,:) = e2v(:,:) * zlv(:,: )156 zcu(:,:) = e1u(:,:) * zlu(:,:,jk) 157 zcv(:,:) = e2v(:,:) * zlv(:,:,jk) 147 158 148 159 ! Laplacian curl ( * e3f if s-coordinates or z-coordinate with partial steps) 149 160 DO jj = 1, jpjm1 150 161 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) & 152 163 & - zcu(ji ,jj+1) + zcu(ji,jj) ) & 153 164 #if defined key_zco … … 163 174 DO ji = 1, fs_jpim1 ! vector opt. 164 175 #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) 170 181 #endif 171 182 END DO … … 180 191 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 181 192 #endif 182 zut(ji,jj ) = ( zlu(ji,jj) - zlu(ji-1,jj) &183 & + zlv(ji,jj) - zlv(ji ,jj-1)) / zbt193 zut(ji,jj,jk) = ( zlu(ji,jj,jk) - zlu(ji-1,jj ,jk) & 194 & + zlv(ji,jj,jk) - zlv(ji ,jj-1,jk) ) / zbt 184 195 END DO 185 196 END DO 197 END DO 186 198 187 199 188 200 ! boundary conditions on the laplacian curl and div (zuf,zut) 201 !!bug gm no need to do this 2 following lbc... 189 202 CALL lbc_lnk( zuf, 'F', 1. ) 190 203 CALL lbc_lnk( zut, 'T', 1. ) 191 204 192 205 DO jk = 1, jpkm1 206 193 207 ! Bilaplacian 194 208 ! ----------- … … 204 218 #endif 205 219 ! 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) 211 225 ! add it to the general momentum trends 212 226 ua(ji,jj,jk) = ua(ji,jj,jk) + zua -
trunk/NEMO/OPA_SRC/DYN/dynspg.F90
r372 r474 168 168 IF(lk_dynspg_rl ) ioptio = ioptio + 1 169 169 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' ) 175 172 176 173 IF( lk_esopa ) nspg = -1 … … 199 196 ! -------------------------- 200 197 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' ) 206 200 ENDIF 207 201 -
trunk/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r455 r474 286 286 CALL sol_sor_e( kindic ) 287 287 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 ) 292 290 ENDIF 293 291 ENDIF -
trunk/NEMO/OPA_SRC/DYN/dynspg_flt_jki.F90
r455 r474 300 300 CALL sol_sor_e( kindic ) 301 301 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 ) 307 304 ENDIF 308 305 -
trunk/NEMO/OPA_SRC/DYN/dynspg_rl.F90
r359 r474 229 229 CALL sol_sor_e( kindic ) 230 230 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 ) 235 233 END SELECT 236 234 ENDIF -
trunk/NEMO/OPA_SRC/DYN/dynvor.F90
r455 r474 677 677 ioptio = ioptio + 1 678 678 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' ) 684 680 IF( lk_esopa ) THEN 685 681 nvor = -1 -
trunk/NEMO/OPA_SRC/LDF/ldfdyn.F90
r461 r474 122 122 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( depth )' 123 123 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)' ) 129 125 #endif 130 126 IF( ioptio == 0 ) THEN 131 127 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = constant (default option)' 132 128 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' ) 137 131 ENDIF 138 132 … … 140 134 IF( ln_dynldf_bilap ) THEN 141 135 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' ) 147 138 ELSE 148 139 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' ) 154 142 ENDIF 155 143 -
trunk/NEMO/OPA_SRC/LDF/ldftra.F90
r461 r474 112 112 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( depth )' 113 113 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' ) 119 116 #endif 120 117 IF( ioptio == 0 ) THEN 121 118 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant (default option)' 122 119 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' ) 127 122 ENDIF 128 123 129 124 IF( ln_traldf_bilap ) THEN 130 125 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' ) 136 128 ELSE 137 129 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' ) 143 132 ENDIF 144 133 -
trunk/NEMO/OPA_SRC/OBC/obcdom.F90
r247 r474 109 109 ! ------------------------------------------------ 110 110 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' ) 117 112 118 113 ! 2. Lecture of 'coastlines' file … … 190 185 191 186 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 ) 196 189 END IF 197 190 … … 350 343 DO jnic = 1, nbobc-1 351 344 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 ) 358 347 END IF 359 348 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 ) 365 351 END IF 366 352 END DO -
trunk/NEMO/OPA_SRC/OBC/obcini.F90
r416 r474 122 122 IF(lwp) WRITE(numout,*) ' Number of open boundaries nbobc = ',nbobc 123 123 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' ) 132 126 133 127 ! control prints … … 204 198 inumfbc = inumfbc+1 205 199 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' ) 211 201 END IF 212 202 END IF … … 218 208 inumfbc = inumfbc+1 219 209 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' ) 225 211 END IF 226 212 END IF … … 232 218 inumfbc = inumfbc+1 233 219 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' ) 239 221 END IF 240 222 END IF … … 246 228 inumfbc = inumfbc+1 247 229 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' ) 253 231 END IF 254 232 END IF … … 605 583 IF( lp_obc_west ) THEN 606 584 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 ) 612 587 END IF 613 588 ztestmask(:)=0. … … 625 600 IF( lp_obc_east ) THEN 626 601 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 ) 632 604 END IF 633 605 ztestmask(:)=0. … … 645 617 IF( lp_obc_north ) THEN 646 618 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 ) 652 621 END IF 653 622 ztestmask(:)=0. … … 665 634 IF( lp_obc_south ) THEN 666 635 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 ) 672 638 END IF 673 639 ztestmask(:)=0. … … 687 653 IF(lwp) WRITE(numout,*) ' ========== ' 688 654 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 693 658 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' ) 696 660 END IF 697 661 … … 701 665 IF(lwp) WRITE(numout,*) ' ========== ' 702 666 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' ) 707 669 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' ) 710 671 END IF 711 672 … … 715 676 IF(lwp) WRITE(numout,*) ' ========== ' 716 677 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' ) 721 680 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' ) 724 682 END IF 725 683 … … 729 687 IF(lwp) WRITE(numout,*) ' ========== ' 730 688 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' ) 735 691 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' ) 738 693 END IF 739 694 … … 792 747 ! ... stop if e r r o r (s) detected 793 748 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 ) 799 751 ENDIF 800 752 ENDIF … … 821 773 ! ... stop if e r r o r (s) detected 822 774 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 ) 828 777 ENDIF 829 778 ENDIF … … 850 799 ! ... stop if e r r o r (s) detected 851 800 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 858 804 ENDIF 859 805 ENDIF … … 879 825 ! ... stop if e r r o r (s) detected 880 826 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 ) 886 829 ENDIF 887 830 ENDIF -
trunk/NEMO/OPA_SRC/OBC/obcrst.F90
r367 r474 102 102 RECL = nreclo, & 103 103 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 111 106 ! 1.2 Write header 112 107 ! ---------------- … … 363 358 RECL = nreclo, & 364 359 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 ' ) 369 361 370 362 ! 1. Read … … 385 377 ! -------------------- 386 378 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 395 384 END IF 396 385 … … 411 400 WRITE(numout,*) ' ' 412 401 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' ) 417 403 END IF 418 404 END IF … … 422 408 WRITE(numout,*) ' ' 423 409 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' ) 428 411 END IF 429 412 END IF … … 433 416 WRITE(numout,*) ' ' 434 417 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' ) 439 419 END IF 440 420 END IF … … 444 424 WRITE(numout,*) ' ' 445 425 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' ) 450 427 END IF 451 428 END IF … … 455 432 ! ------------------------------------------ 456 433 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' ) 467 436 END IF 468 437 469 438 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' ) 480 441 END IF 481 442 482 443 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' ) 493 446 END IF 494 447 495 448 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' ) 506 451 END IF 507 452 -
trunk/NEMO/OPA_SRC/SBC/flxfwb.F90
r359 r474 297 297 IF(lwp)WRITE(numout,*)' year = ',iyear-2, ' freshwater budget read = ', a_fwb_b 298 298 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 ) 302 301 ENDIF 303 302 ! ! ============================== -
trunk/NEMO/OPA_SRC/SOL/solver.F90
r413 r474 133 133 IF(lwp) WRITE(numout,*) 134 134 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 140 137 ELSEIF( lk_dynspg_rl ) THEN 141 138 IF(lwp) WRITE(numout,*) 142 139 IF(lwp) WRITE(numout,*) ' Rigid lid formulation' 143 140 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' ) 154 146 155 147 SELECT CASE ( nsolv ) … … 157 149 CASE ( 1 ) ! preconditioned conjugate gradient solver 158 150 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' ) 164 153 165 154 CASE ( 2 ) ! successive-over-relaxation solver 166 155 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' ) 172 158 173 159 CASE ( 3 ) ! FETI solver 174 160 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 180 164 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' ) 184 166 ELSE 185 167 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' ) 189 169 ENDIF 190 170 ENDIF … … 194 174 IF(lwp) WRITE(numout,*) ' with jpr2di =', jpr2di, ' and jpr2dj =', jpr2dj 195 175 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' ) 200 178 ELSE 201 179 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' ) 207 181 ENDIF 208 182 209 183 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 ) 213 186 214 187 END SELECT … … 244 217 245 218 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 ) 249 221 ENDIF 250 222 -
trunk/NEMO/OPA_SRC/TRA/traadv.F90
r458 r474 166 166 IF( ln_traadv_muscl2 ) ioptio = ioptio + 1 167 167 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' ) 173 170 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' ) 179 173 180 174 ! Set nadv -
trunk/NEMO/OPA_SRC/TRA/traadv_ctl.F90
r359 r474 85 85 ln_traadv_muscl2 = .TRUE. 86 86 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 & ' *** ***********' ) 91 89 ENDIF 92 90 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' ) 98 93 99 94 END SUBROUTINE tra_adv_ctl -
trunk/NEMO/OPA_SRC/TRA/trabbl.F90
r457 r474 321 321 CASE ( 2 ) ! Linear formulation function of temperature and salinity 322 322 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 ' ) 327 325 328 326 CASE DEFAULT 329 327 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) 333 330 334 331 END SELECT -
trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90
r457 r474 237 237 CASE ( 2 ) ! Linear formulation function of temperature and salinity 238 238 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 ' ) 243 241 244 242 CASE DEFAULT 245 243 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 ) 249 246 250 247 END SELECT -
trunk/NEMO/OPA_SRC/TRA/traldf.F90
r458 r474 168 168 IF( ln_traldf_lap ) ioptio = ioptio + 1 169 169 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' ) 175 171 ioptio = 0 176 172 IF( ln_traldf_level ) ioptio = ioptio + 1 177 173 IF( ln_traldf_hor ) ioptio = ioptio + 1 178 174 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)' ) 184 176 185 177 ! defined the type of lateral diffusion from ln_traldf_... logicals … … 221 213 ENDIF 222 214 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' ) 239 220 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' ) 245 222 ENDIF 246 223 … … 320 297 va (:,:,:) = sa (:,:,:) 321 298 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' ) 327 300 ! set tb, sb to reference values and avr to zero 328 301 tb (:,:,:) = zt_ref(:,:,:) -
trunk/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r457 r474 90 90 REAL(wp) :: zta, zsa ! temporary scalars 91 91 REAL(wp), DIMENSION(jpi,jpj) :: & 92 zeeu, zeev, zbtr, & ! 2D workspace 93 zlt, zls 92 zeeu, zeev, zbtr ! 2D workspace arrays 94 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 95 zsu, zsv ! 3D workspace94 zsu, zsv, zlt, zls ! 3D workspace arrays 96 95 !!---------------------------------------------------------------------- 97 96 … … 101 100 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 102 101 ENDIF 103 104 102 105 103 ! ! =============== … … 162 160 DO jj = 2, jpjm1 163 161 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) ) 166 164 END DO 167 165 END DO … … 170 168 DO jj = 2, jpjm1 171 169 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 180 181 ! 2. Bilaplacian 181 182 ! -------------- … … 184 185 DO jj = 1, jpjm1 185 186 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) ) 190 191 END DO 191 192 END DO -
trunk/NEMO/OPA_SRC/TRA/traqsr.F90
r457 r474 245 245 ENDIF 246 246 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' ) 253 249 254 250 ! Initialization of gdsr -
trunk/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r463 r474 225 225 226 226 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 ) 230 229 231 230 END SELECT -
trunk/NEMO/OPA_SRC/ZDF/zdfini.F90
r463 r474 105 105 ioptio = ioptio+1 106 106 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 ' ) 112 109 113 110 ! ... Convection … … 133 130 ENDIF 134 131 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' ) 147 137 148 138 END SUBROUTINE zdf_init -
trunk/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r463 r474 1505 1505 1506 1506 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 ) 1510 1509 1511 1510 END SELECT -
trunk/NEMO/OPA_SRC/ZDF/zdftke.F90
r463 r474 680 680 681 681 ! 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 ' ) 693 684 694 685 ! Horizontal average : initialization of weighting arrays … … 761 752 762 753 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 ) 766 756 767 757 END SELECT -
trunk/NEMO/OPA_SRC/eosbn2.F90
r467 r474 219 219 CASE DEFAULT 220 220 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 ) 224 223 225 224 END SELECT … … 407 406 CASE DEFAULT 408 407 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 ) 412 410 413 411 END SELECT … … 586 584 CASE DEFAULT 587 585 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 ) 591 588 592 589 END SELECT … … 761 758 CASE DEFAULT 762 759 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 ) 766 762 767 763 END SELECT … … 827 823 828 824 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' ) 835 827 836 828 CASE ( 2 ) ! Linear formulation function of temperature and salinity … … 840 832 CASE DEFAULT 841 833 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 ) 845 836 846 837 END SELECT -
trunk/NEMO/OPA_SRC/geo2ocean.F90
r247 r474 255 255 256 256 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 ) 260 259 END SELECT 261 260 … … 327 326 IF( kchoix == 0 ) THEN 328 327 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 ' ) 336 333 ELSE 337 334 kchoix = nmem … … 340 337 nmem = kchoix 341 338 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 ' ) 346 341 ENDIF 347 342 -
trunk/NEMO/OPA_SRC/mppini.F90
r434 r474 77 77 ENDIF 78 78 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! ' ) 86 82 87 83 END SUBROUTINE mpp_init … … 467 463 ENDIF 468 464 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' ) 474 466 475 467 ! Prepare mpp north fold -
trunk/NEMO/OPA_SRC/step.F90
r467 r474 405 405 ! ! Time loop: control and print 406 406 CALL stp_ctl( kstp, indic ) 407 IF ( indic < 0 ) nstop = nstop + 1407 IF ( indic < 0 ) CALL ctl_stop( 'step: indic < 0' ) 408 408 409 409 IF ( nstop == 0 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.