Changeset 10572 for NEMO/trunk/tests
- Timestamp:
- 2019-01-24T16:37:13+01:00 (5 years ago)
- Location:
- NEMO/trunk/tests
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/CANAL/MY_SRC/stpctl.F90
r10566 r10572 67 67 REAL(wp) :: zzz ! local real 68 68 REAL(wp), DIMENSION(9) :: zmax 69 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 69 70 CHARACTER(len=20) :: clname 70 71 !!---------------------------------------------------------------------- 71 72 ! 73 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 74 ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) 75 ll_wrtruns = ll_colruns .AND. lwm 72 76 IF( kt == nit000 .AND. lwp ) THEN 73 77 WRITE(numout,*) … … 76 80 ! ! open time.step file 77 81 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 78 ! ! open run.stat file 79 IF( ln_ctl .AND. lwm ) THEN 82 ! ! open run.stat file(s) at start whatever 83 ! ! the value of sn_cfctl%ptimincr 84 IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN 80 85 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 81 86 clname = 'run.stat.nc' … … 99 104 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 100 105 ! 101 IF(lwm ) THEN!== current time step ==! ("time.step" file)106 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 102 107 WRITE ( numstp, '(1x, i8)' ) kt 103 108 REWIND( numstp ) … … 121 126 ENDIF 122 127 ! 123 IF( l k_mpp .AND. ln_ctl) THEN128 IF( ll_colruns ) THEN 124 129 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 125 130 nstop = NINT( zmax(7) ) ! nstop indicator sheared among all local domains 126 131 ENDIF 127 132 ! !== run statistics ==! ("run.stat" files) 128 IF( l n_ctl .AND. lwm) THEN133 IF( ll_wrtruns ) THEN 129 134 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 130 135 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) … … 145 150 & zmax(1) > 50._wp .OR. & ! too large sea surface height ( > 50 m ) 146 151 & zmax(2) > 20._wp .OR. & ! too large velocity ( > 20 m/s) 147 & zmax(3) >= 100._wp .OR. & ! too small sea surface salinity ( < -100 ) 148 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 )149 & zmax(4) < -100._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice)150 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests152 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 153 !!$ & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 154 !!$ & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 155 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 151 156 IF( lk_mpp .AND. ln_ctl ) THEN 152 157 CALL mpp_maxloc( 'stpctl', ABS(sshn) , ssmask(:,:) , zzz, ih ) … … 160 165 is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 161 166 ENDIF 162 IF( numout == 6 ) & ! force to open ocean.output file 163 CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 164 165 WRITE(numout,cform_err) 166 WRITE(numout,*) ' stp_ctl: |ssh| > 50 m or |U| > 20 m/s or S <= -100 or S >= 100 or NaN encounter in the tests' 167 WRITE(numout,*) ' ======= ' 168 IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea 169 WRITE(numout,9100) kt, zmax(1), ih(1) , ih(2) 170 WRITE(numout,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 171 WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 172 WRITE(numout,9400) kt, zmax(4), is2(1), is2(2), is2(3) 173 WRITE(numout,*) 174 WRITE(numout,*) ' output of last computed fields in output.abort.nc file' 167 168 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 50 m or |U| > 20 m/s or NaN encounter in the tests' 169 WRITE(ctmp2,9100) kt, zmax(1), ih(1) , ih(2) 170 WRITE(ctmp3,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 171 WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 172 WRITE(ctmp5,9400) kt, zmax(4), is2(1), is2(2), is2(3) 173 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort.nc file' 175 174 176 175 CALL dia_wri_state( 'output.abort' ) ! create an output.abort file 177 176 178 IF( ln_ctl ) THEN179 kindic = -3180 nstop = nstop + 1 ! increase nstop by 1 (on all local domains)177 IF( .NOT. ln_ctl ) THEN 178 WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 179 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 ) 181 180 ELSE 182 CALL ctl_stop() 183 CALL mppstop(ld_force_abort = .true.) 181 CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' ) 184 182 ENDIF 183 184 kindic = -3 185 185 ! 186 186 ENDIF -
NEMO/trunk/tests/CANAL/MY_SRC/trazdf.F90
r10425 r10572 136 136 ! 137 137 INTEGER :: ji, jj, jk, jn ! dummy loop indices 138 REAL(wp) :: zrhs 138 REAL(wp) :: zrhs, zzwi, zzws ! local scalars 139 139 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwt, zwd, zws 140 140 !!--------------------------------------------------------------------- … … 177 177 ! 178 178 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 179 DO jk = 1, jpkm1 180 DO jj = 2, jpjm1 181 DO ji = fs_2, fs_jpim1 ! vector opt. 182 !!gm BUG I think, use e3w_a instead of e3w_n, not sure of that 183 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w_n(ji,jj,jk ) 184 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 185 zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk) 186 END DO 187 END DO 188 END DO 179 IF( ln_zad_Aimp ) THEN ! Adaptive implicit vertical advection 180 DO jk = 1, jpkm1 181 DO jj = 2, jpjm1 182 DO ji = fs_2, fs_jpim1 ! vector opt. (ensure same order of calculation as below if wi=0.) 183 zzwi = - p2dt * zwt(ji,jj,jk ) / e3w_n(ji,jj,jk ) 184 zzws = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 185 zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zzwi - zzws & 186 & + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 187 zwi(ji,jj,jk) = zzwi + p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) 188 zws(ji,jj,jk) = zzws - p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) 189 END DO 190 END DO 191 END DO 192 ELSE 193 DO jk = 1, jpkm1 194 DO jj = 2, jpjm1 195 DO ji = fs_2, fs_jpim1 ! vector opt. 196 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w_n(ji,jj,jk) 197 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 198 zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk) 199 END DO 200 END DO 201 END DO 202 ENDIF 189 203 ! 190 204 !! Matrix inversion from the first level -
NEMO/trunk/tests/VORTEX/MY_SRC/domvvl.F90
r10425 r10572 938 938 END DO 939 939 e3t_n(:,:,:) = e3t_b(:,:,:) 940 !!$ sshn(:,:)=0._wp 940 sshn(:,:) = sshb(:,:) ! needed later for gde3w 941 941 !!$ e3t_n(:,:,:)=e3t_0(:,:,:) 942 942 !!$ e3t_b(:,:,:)=e3t_0(:,:,:)
Note: See TracChangeset
for help on using the changeset viewer.