Changeset 1489
- Timestamp:
- 2009-07-16T15:44:39+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/stpctl.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/stpctl.F90
r1442 r1489 1 1 MODULE stpctl 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE stpctl *** 4 4 !! Ocean run control : gross check of the ocean time stepping 5 !!============================================================================== 5 !!====================================================================== 6 !! History : OPA ! 1991-03 (G. Madec) Original code 7 !! 6.0 ! 1992-06 (M. Imbard) 8 !! 8.0 ! 1997-06 (A.M. Treguier) 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 !! 2.0 ! 2009-07 (G. Madec) Add statistic for time-spliting 11 !!---------------------------------------------------------------------- 6 12 7 13 !!---------------------------------------------------------------------- 8 14 !! stp_ctl : Control the run 9 15 !!---------------------------------------------------------------------- 10 !! * Modules used11 16 USE oce ! ocean dynamics and tracers variables 12 17 USE dom_oce ! ocean space and time domain variables … … 22 27 PRIVATE 23 28 24 !! * Accessibility25 29 PUBLIC stp_ctl ! routine called by step.F90 30 !!---------------------------------------------------------------------- 31 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 32 !! $Id$ 33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 26 34 !!---------------------------------------------------------------------- 27 35 … … 39 47 !! - Stop the run IF problem for the solver ( indec < 0 ) 40 48 !! 41 !! History : 42 !! ! 91-03 () 43 !! ! 91-11 (G. Madec) 44 !! ! 92-06 (M. Imbard) 45 !! ! 97-06 (A.M. Treguier) 46 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 49 !! ** Actions : 'time.step' file containing the last ocean time-step 50 !! 47 51 !!---------------------------------------------------------------------- 48 !! * Arguments49 52 INTEGER, INTENT( in ) :: kt ! ocean time-step index 50 53 INTEGER, INTENT( inout ) :: kindic ! indicator of solver convergence 51 52 !! * local declarations 54 !! 53 55 INTEGER :: ji, jj, jk ! dummy loop indices 54 56 INTEGER :: ii, ij, ik ! temporary integers 55 REAL(wp) :: zumax, zsmin 57 REAL(wp) :: zumax, zsmin, zssh2 ! temporary scalars 56 58 INTEGER, DIMENSION(3) :: ilocu ! 57 59 INTEGER, DIMENSION(2) :: ilocs ! 58 60 CHARACTER(len=80) :: clname 59 !!----------------------------------------------------------------------60 !! OPA 9.0 , LOCEAN-IPSL (2005)61 !! $Id$62 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt63 61 !!---------------------------------------------------------------------- 64 62 … … 72 70 ENDIF 73 71 74 ! save the current time step in numstp 75 ! ------------------------------------ 76 IF(lwp) WRITE(numstp,9100) kt 77 IF(lwp) REWIND(numstp) 78 9100 FORMAT(1x, i8) 72 IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp 73 IF(lwp) REWIND( numstp ) ! -------------------------- 79 74 80 81 ! elliptic solver statistics (if required) 82 ! -------------------------- 83 IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN 84 ! Solver 85 IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps 86 87 ! Islands (if exist) 88 IF( lk_isl ) CALL isl_stp_ctl( kt, kindic ) 89 90 91 ! Output in numwso and numwvo IF kindic<0 92 ! --------------------------------------- 93 ! (i.e. problem for the solver) 94 IF( kindic < 0 ) THEN 95 IF(lwp) THEN 96 WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode' 97 WRITE(numout,*) ' ====== ' 98 WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps 99 WRITE(numout,*) 100 WRITE(numout,*) ' stpctl: output of last fields in numwso' 101 WRITE(numout,*) ' numwvo' 102 WRITE(numout,*) ' ====== *******************************' 103 ENDIF 104 CALL dia_wri( kt, kindic ) 105 ENDIF 106 ENDIF 107 108 9200 FORMAT(' it :', i8, ' niter :', i4, ' res :',e20.10,' b :',e20.10) 109 110 ! Test maximum of velocity (zonal only) 111 ! ------------------------ 112 !! zumax = MAXVAL( ABS( un(:,:,:) ) ) ! slower than the following loop on NEC SX5 75 ! !* Test maximum of velocity (zonal only) 76 ! ! ------------------------ 77 !! zumax = MAXVAL( ABS( un(:,:,:) ) ) ! slower than the following loop on NEC SX5 113 78 zumax = 0.e0 114 79 DO jk = 1, jpk … … 119 84 END DO 120 85 END DO 121 IF( lk_mpp ) CALL mpp_max( zumax ) ! max over the global domain 122 123 IF( MOD( kt, nwrite ) == 1 ) THEN 124 IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax 125 ENDIF 86 IF( lk_mpp ) CALL mpp_max( zumax ) ! max over the global domain 87 ! 88 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax 89 ! 126 90 IF( zumax > 20.) THEN 127 91 IF( lk_mpp ) THEN … … 141 105 WRITE(numout,*) ' output of last fields in numwso' 142 106 ENDIF 143 kindic = -3 144 145 CALL dia_wri( kt, kindic ) 107 IF( kindic >= 0 ) THEN ! create a abort file (only if not already done) 108 kindic = -3 109 CALL dia_wri( kt, kindic ) 110 ENDIF 146 111 ENDIF 147 112 9400 FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5) 148 113 149 150 ! Test minimum of salinity 151 ! ------------------------ 152 !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 ) 153 ! slower than the following loop on NEC SX5 114 ! !* Test minimum of salinity 115 ! ! ------------------------ 116 !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 ) slower than the following loop on NEC SX5 154 117 zsmin = 100.e0 155 118 DO jj = 2, jpjm1 … … 158 121 END DO 159 122 END DO 160 IF( lk_mpp ) CALL mpp_min( zsmin ) ! min over the global domain 161 162 IF( MOD( kt, nwrite ) == 1 ) THEN 163 IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin 164 ENDIF 123 IF( lk_mpp ) CALL mpp_min( zsmin ) ! min over the global domain 124 ! 125 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin 126 ! 165 127 IF( zsmin < 0.) THEN 166 128 IF (lk_mpp) THEN … … 170 132 ii = ilocs(1) + nimpp - 1 171 133 ij = ilocs(2) + njmpp - 1 172 END 173 134 ENDIF 135 ! 174 136 IF(lwp) THEN 175 137 WRITE(numout,cform_err) … … 180 142 WRITE(numout,*) ' output of last fields in numwso' 181 143 ENDIF 182 IF( kindic < 0 ) THEN 183 IF(lwp) WRITE(numout,*) ' stpctl diabort done. We wont do it again ' 184 ELSE 144 IF( kindic >= 0 ) THEN ! create a abort file (only if not already done) 185 145 kindic = -3 186 CALL dia_wri( kt,kindic)146 CALL dia_wri( kt, kindic ) 187 147 ENDIF 188 148 ENDIF 189 149 9500 FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 190 150 151 ! log file (solver or ssh statistics) 152 ! -------- 153 IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN ! elliptic solver statistics (if required) 154 ! 155 IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps ! Solver 156 ! 157 IF( lk_isl ) CALL isl_stp_ctl( kt, kindic ) ! Islands (if exist) 158 ! 159 IF( kindic < 0 ) THEN ! create a abort file if problem found 160 IF(lwp) THEN 161 WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode' 162 WRITE(numout,*) ' ====== ' 163 WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps 164 WRITE(numout,*) 165 WRITE(numout,*) ' stpctl: output of last fields' 166 WRITE(numout,*) ' ====== ' 167 ENDIF 168 CALL dia_wri( kt, kindic ) 169 ENDIF 170 ! 171 ELSE !* ssh statistics (and others...) 172 IF( kt == nit000 ) THEN ! open ssh statistics file (put in solver.stat file) 173 CALL ctlopn( numsol, 'solver.stat', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 174 ENDIF 175 ! 176 zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) ) 177 IF( lk_mpp ) CALL mpp_sum( zssh2 ) ! sum over the global domain 178 ! 179 IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin ! ssh statistics 180 ! 181 ENDIF 182 183 9200 FORMAT(' it :', i8, ' niter :', i4, ' res :',e20.10,' b :',e20.10) 184 9300 FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10) 185 ! 191 186 END SUBROUTINE stp_ctl 192 187
Note: See TracChangeset
for help on using the changeset viewer.
