- Timestamp:
- 2018-06-30T12:51:02+02:00 (6 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9838_ENHANCE04_MLF/src/OCE/DOM/restart.F90
r9839 r9863 8 8 !! 2.0 ! 2006-07 (S. Masson) use IOM for restart 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) modified LF-RA 10 !! - - ! 2010-10 (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 12 !! - ! 2014-12 (G. Madec) remove KPP scheme 13 !!---------------------------------------------------------------------- 14 15 !!---------------------------------------------------------------------- 16 !! rst_opn : open the ocean restart file 17 !! rst_write : write the ocean restart file 18 !! rst_read : read the ocean restart file 19 !!---------------------------------------------------------------------- 20 USE oce ! ocean dynamics and tracers 21 USE dom_oce ! ocean space and time domain 22 USE sbc_ice ! only lk_si3 23 USE phycst ! physical constants 24 USE eosbn2 ! equation of state (eos bn2 routine) 25 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 10 !! - - ! 2010-10 (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 12 !! - ! 2014-12 (G. Madec) remove KPP scheme 13 !! 4.0 ! 2018-06 (G. Madec) introduce l_1st_euler 14 !!---------------------------------------------------------------------- 15 16 !!---------------------------------------------------------------------- 17 !! rst_opn : open the ocean restart file in write mode 18 !! rst_write : write the ocean restart file 19 !! rst_read_open : open the ocean restart file in read mode 20 !! rst_read : read the ocean restart file 21 !!---------------------------------------------------------------------- 22 USE oce ! ocean dynamics and tracers 23 USE dom_oce ! ocean space and time domain 24 USE sbc_ice ! only lk_si3 25 USE phycst ! physical constants 26 USE eosbn2 ! equation of state (eos bn2 routine) 27 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 28 USE diurnal_bulk ! 26 29 ! 27 USE in_out_manager ! I/O manager 28 USE iom ! I/O module 29 USE diurnal_bulk 30 USE in_out_manager ! I/O manager 31 USE iom ! I/O module 30 32 31 33 IMPLICIT NONE … … 34 36 PUBLIC rst_opn ! routine called by step module 35 37 PUBLIC rst_write ! routine called by step module 38 PUBLIC rst_read_open ! routine called in rst_read and (possibly) in dom_vvl_init 36 39 PUBLIC rst_read ! routine called by istate module 37 PUBLIC rst_read_open ! routine called in rst_read and (possibly) in dom_vvl_init38 40 39 41 !! * Substitutions … … 144 146 INTEGER, INTENT(in) :: kt ! ocean time-step 145 147 !!---------------------------------------------------------------------- 146 IF(lwxios) CALL iom_swap( cwxios_context ) 147 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt , ldxios = lwxios) ! dynamics time step 148 149 IF ( .NOT. ln_diurnal_only ) THEN 150 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub, ldxios = lwxios ) ! before fields 151 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb, ldxios = lwxios ) 152 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem), ldxios = lwxios ) 153 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal), ldxios = lwxios ) 154 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb, ldxios = lwxios ) 155 ! 156 CALL iom_rstput( kt, nitrst, numrow, 'un' , un, ldxios = lwxios ) ! now fields 157 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn, ldxios = lwxios ) 158 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem), ldxios = lwxios ) 159 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal), ldxios = lwxios ) 160 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn, ldxios = lwxios ) 161 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios ) 162 ! extra variable needed for the ice sheet coupling 163 IF ( ln_iscpl ) THEN 164 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask, ldxios = lwxios ) ! need to extrapolate T/S 165 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask, ldxios = lwxios ) ! need to correct barotropic velocity 166 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask, ldxios = lwxios ) ! need to correct barotropic velocity 167 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask, ldxios = lwxios) ! need to correct barotropic velocity 168 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios ) ! need to compute temperature correction 169 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation 170 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation 171 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl 172 END IF 173 ENDIF 174 175 IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 176 IF(lwxios) CALL iom_swap( cxios_context ) 148 IF( lwxios ) CALL iom_swap( cwxios_context ) 149 150 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rn_rdt , ldxios = lwxios ) ! dynamics time step 151 ! 152 IF( .NOT. ln_diurnal_only ) THEN 153 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub , ldxios = lwxios ) ! before fields 154 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb , ldxios = lwxios ) 155 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem), ldxios = lwxios ) 156 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal), ldxios = lwxios ) 157 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb , ldxios = lwxios ) 158 ! 159 CALL iom_rstput( kt, nitrst, numrow, 'un' , un , ldxios = lwxios ) ! now fields 160 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn , ldxios = lwxios ) 161 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem), ldxios = lwxios ) 162 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal), ldxios = lwxios ) 163 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn , ldxios = lwxios ) 164 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop , ldxios = lwxios ) 165 ! 166 IF( ln_iscpl ) THEN ! extra variable needed for the ice sheet coupling 167 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask , ldxios = lwxios ) ! need to extrapolate T/S 168 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask , ldxios = lwxios ) ! need to correct barotropic velocity 169 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask , ldxios = lwxios ) ! need to correct barotropic velocity 170 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask , ldxios = lwxios ) ! need to correct barotropic velocity 171 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n' , e3t_n , ldxios = lwxios ) ! need to compute temperature correction 172 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n' , e3u_n , ldxios = lwxios ) ! need to compute bt conservation 173 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n' , e3v_n , ldxios = lwxios ) ! need to compute bt conservation 174 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n, ldxios = lwxios ) ! need to compute extrapolation if vvl 175 ENDIF 176 ENDIF 177 ! 178 IF( ln_diurnal ) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 179 IF( lwxios ) CALL iom_swap( cxios_context ) 177 180 IF( kt == nitrst ) THEN 178 IF(.NOT.lwxios) THEN 179 CALL iom_close( numrow ) ! close the restart file (only at last time step) 180 ELSE 181 CALL iom_context_finalize( cwxios_context ) 181 IF( lwxios ) THEN ; CALL iom_context_finalize( cwxios_context ) 182 ELSE ; CALL iom_close( numrow ) ! close the restart file (only at last time step) 182 183 ENDIF 183 184 !!gm IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 184 185 !!gm not sure what to do here ===>>> ask to Sebastian 185 186 lrst_oce = .FALSE. 186 187 188 189 187 IF( ln_rst_list ) THEN 188 nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 189 nitrst = nstocklist( nrst_lst ) 190 ENDIF 190 191 ENDIF 191 192 ! … … 202 203 !! the file has already been opened 203 204 !!---------------------------------------------------------------------- 204 INTEGER 205 LOGICAL 206 CHARACTER(lc) 205 INTEGER :: jlibalt = jprstlib 206 LOGICAL :: llok 207 CHARACTER(lc) :: clpath ! full path to ocean output restart file 207 208 !!---------------------------------------------------------------------- 208 209 ! … … 238 239 ENDIF 239 240 ENDIF 240 241 ! 241 242 END SUBROUTINE rst_read_open 242 243 … … 254 255 REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 255 256 !!---------------------------------------------------------------------- 256 257 ! 257 258 CALL rst_read_open ! open restart for reading (if not already opened) 258 259 … … 260 261 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 261 262 CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios ) 262 IF( zrdt /= rdt ) neuler = 0 263 IF( zrdt /= rn_rdt ) THEN 264 IF(lwp) WRITE( numout,*) 265 IF(lwp) WRITE( numout,*) 'rst_read: rdt not equal to the read one' 266 IF(lwp) WRITE( numout,*) 267 IF(lwp) WRITE( numout,*) ' ==>>> forced euler first time-step' 268 l_1st_euler = .TRUE. 269 ENDIF 263 270 ENDIF 264 271 … … 266 273 IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios ) 267 274 IF ( ln_diurnal_only ) THEN 268 IF(lwp) WRITE( numout, * ) & 269 & "rst_read:- ln_diurnal_only set, setting rhop=rau0" 275 IF(lwp) WRITE( numout,*) 'rst_read: ln_diurnal_only set, setting rhop=rau0' 270 276 rhop = rau0 271 277 CALL iom_get( numror, jpdom_autoglo, 'tn' , w3d, ldxios = lrxios ) … … 274 280 ENDIF 275 281 276 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN282 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 .AND. .NOT.l_1st_euler ) THEN 277 283 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub, ldxios = lrxios ) ! before fields 278 284 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb, ldxios = lrxios ) … … 281 287 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb, ldxios = lrxios ) 282 288 ELSE 283 neuler = 0289 l_1st_euler = .TRUE. ! before field not found, forced euler 1st time-step 284 290 ENDIF 285 291 ! … … 295 301 ENDIF 296 302 ! 297 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 298 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values 299 ub (:,:,:) = un (:,:,:) 300 vb (:,:,:) = vn (:,:,:) 301 sshb (:,:) = sshn (:,:) 302 ! 303 IF( .NOT.ln_linssh ) THEN 304 DO jk = 1, jpk 305 e3t_b(:,:,jk) = e3t_n(:,:,jk) 306 END DO 307 ENDIF 308 ! 303 IF( l_1st_euler ) THEN ! Euler restart 304 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values 305 ub (:,:,:) = un (:,:,:) 306 vb (:,:,:) = vn (:,:,:) 307 sshb(:,:) = sshn(:,:) 308 IF( .NOT.ln_linssh ) e3t_b(:,:,:) = e3t_n(:,:,:) 309 309 ENDIF 310 310 !
Note: See TracChangeset
for help on using the changeset viewer.
