- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/IOM/restart.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/IOM/restart.F90
r11405 r13463 27 27 USE in_out_manager ! I/O manager 28 28 USE iom ! I/O module 29 USE diu rnal_bulk29 USE diu_bulk 30 30 USE lib_mpp ! distribued memory computing library 31 31 … … 38 38 PUBLIC rst_read_open ! routine called in rst_read and (possibly) in dom_vvl_init 39 39 40 !! * Substitutions41 # include "vectopt_loop_substitute.h90"42 40 !!---------------------------------------------------------------------- 43 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 70 68 IF( ln_rst_list ) THEN 71 69 nrst_lst = 1 72 nitrst = n stocklist( nrst_lst )70 nitrst = nn_stocklist( nrst_lst ) 73 71 ELSE 74 72 nitrst = nitend 75 73 ENDIF 76 74 ENDIF 75 76 IF( .NOT. ln_rst_list .AND. nn_stock == -1 ) RETURN ! we will never do any restart 77 77 78 78 ! frequency-based restart dumping (nn_stock) 79 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, n stock ) == 0 ) THEN79 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN 80 80 ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 81 nitrst = kt + n stock - 1 ! define the next value of nitrst for restart writing81 nitrst = kt + nn_stock - 1 ! define the next value of nitrst for restart writing 82 82 IF( nitrst > nitend ) nitrst = nitend ! make sure we write a restart at the end of the run 83 83 ENDIF … … 85 85 ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1) 86 86 ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 87 IF( kt == nitrst - 1 .OR. n stock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN87 IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 88 88 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 89 89 ! beware of the format used to write kt (default is i8.8, that should be large enough...) … … 131 131 132 132 133 SUBROUTINE rst_write( kt )133 SUBROUTINE rst_write( kt, Kbb, Kmm ) 134 134 !!--------------------------------------------------------------------- 135 135 !! *** ROUTINE rstwrite *** … … 140 140 !! file, save fields which are necessary for restart 141 141 !!---------------------------------------------------------------------- 142 INTEGER, INTENT(in) :: kt ! ocean time-step 142 INTEGER, INTENT(in) :: kt ! ocean time-step 143 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 143 144 !!---------------------------------------------------------------------- 144 145 IF(lwxios) CALL iom_swap( cwxios_context ) 145 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , r dt , ldxios = lwxios) ! dynamics time step146 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rn_Dt , ldxios = lwxios) ! dynamics time step 146 147 CALL iom_delay_rst( 'WRITE', 'OCE', numrow ) ! save only ocean delayed global communication variables 147 148 148 149 IF ( .NOT. ln_diurnal_only ) THEN 149 CALL iom_rstput( kt, nitrst, numrow, 'ub' , u b, ldxios = lwxios ) ! before fields150 CALL iom_rstput( kt, nitrst, numrow, 'vb' , v b, ldxios = lwxios )151 CALL iom_rstput( kt, nitrst, numrow, 'tb' , ts b(:,:,:,jp_tem), ldxios = lwxios )152 CALL iom_rstput( kt, nitrst, numrow, 'sb' , ts b(:,:,:,jp_sal), ldxios = lwxios )153 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb, ldxios = lwxios )150 CALL iom_rstput( kt, nitrst, numrow, 'ub' , uu(:,:,: ,Kbb), ldxios = lwxios ) ! before fields 151 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vv(:,:,: ,Kbb), ldxios = lwxios ) 152 CALL iom_rstput( kt, nitrst, numrow, 'tb' , ts(:,:,:,jp_tem,Kbb), ldxios = lwxios ) 153 CALL iom_rstput( kt, nitrst, numrow, 'sb' , ts(:,:,:,jp_sal,Kbb), ldxios = lwxios ) 154 CALL iom_rstput( kt, nitrst, numrow, 'sshb' ,ssh(:,: ,Kbb), ldxios = lwxios ) 154 155 ! 155 CALL iom_rstput( kt, nitrst, numrow, 'un' , u n, ldxios = lwxios ) ! now fields156 CALL iom_rstput( kt, nitrst, numrow, 'vn' , v n, ldxios = lwxios )157 CALL iom_rstput( kt, nitrst, numrow, 'tn' , ts n(:,:,:,jp_tem), ldxios = lwxios )158 CALL iom_rstput( kt, nitrst, numrow, 'sn' , ts n(:,:,:,jp_sal), ldxios = lwxios )159 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn, ldxios = lwxios )156 CALL iom_rstput( kt, nitrst, numrow, 'un' , uu(:,:,: ,Kmm), ldxios = lwxios ) ! now fields 157 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vv(:,:,: ,Kmm), ldxios = lwxios ) 158 CALL iom_rstput( kt, nitrst, numrow, 'tn' , ts(:,:,:,jp_tem,Kmm), ldxios = lwxios ) 159 CALL iom_rstput( kt, nitrst, numrow, 'sn' , ts(:,:,:,jp_sal,Kmm), ldxios = lwxios ) 160 CALL iom_rstput( kt, nitrst, numrow, 'sshn' ,ssh(:,: ,Kmm), ldxios = lwxios ) 160 161 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios ) 161 ! extra variable needed for the ice sheet coupling162 IF ( ln_iscpl ) THEN163 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask, ldxios = lwxios ) ! need to extrapolate T/S164 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask, ldxios = lwxios ) ! need to correct barotropic velocity165 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask, ldxios = lwxios ) ! need to correct barotropic velocity166 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask, ldxios = lwxios) ! need to correct barotropic velocity167 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios ) ! need to compute temperature correction168 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation169 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation170 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl171 END IF172 162 ENDIF 173 163 … … 184 174 lrst_oce = .FALSE. 185 175 IF( ln_rst_list ) THEN 186 nrst_lst = MIN(nrst_lst + 1, SIZE(n stocklist,1))187 nitrst = n stocklist( nrst_lst )176 nrst_lst = MIN(nrst_lst + 1, SIZE(nn_stocklist,1)) 177 nitrst = nn_stocklist( nrst_lst ) 188 178 ENDIF 189 179 ENDIF … … 224 214 IF( .NOT.lxios_set ) THEN 225 215 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 226 CALL iom_init( crxios_context , ld_tmppatch = .false.)216 CALL iom_init( crxios_context ) 227 217 lxios_set = .TRUE. 228 218 ENDIF 229 219 ENDIF 230 220 IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 231 CALL iom_init( crxios_context , ld_tmppatch = .false.)221 CALL iom_init( crxios_context ) 232 222 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 233 223 lxios_set = .TRUE. … … 238 228 239 229 240 SUBROUTINE rst_read 230 SUBROUTINE rst_read( Kbb, Kmm ) 241 231 !!---------------------------------------------------------------------- 242 232 !! *** ROUTINE rst_read *** … … 246 236 !! ** Method : Read in restart.nc file fields which are necessary for restart 247 237 !!---------------------------------------------------------------------- 238 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 248 239 REAL(wp) :: zrdt 249 240 INTEGER :: jk … … 259 250 IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 260 251 IF( zrdt /= rdt ) neuler = 0 252 IF( zrdt /= rn_Dt ) THEN 253 IF(lwp) WRITE( numout,*) 254 IF(lwp) WRITE( numout,*) 'rst_read: rdt not equal to the read one' 255 IF(lwp) WRITE( numout,*) 256 IF(lwp) WRITE( numout,*) ' ==>>> forced euler first time-step' 257 l_1st_euler = .TRUE. 258 ENDIF 261 259 ENDIF 262 260 … … 265 263 ! Diurnal DSST 266 264 IF(lrxios) CALL iom_swap( TRIM(crxios_context) ) 267 IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto glo, 'Dsst' , x_dsst, ldxios = lrxios )265 IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst, ldxios = lrxios ) 268 266 IF ( ln_diurnal_only ) THEN 269 267 IF(lwp) WRITE( numout, * ) & 270 & "rst_read:- ln_diurnal_only set, setting rhop=r au0"271 rhop = r au0272 CALL iom_get( numror, jpdom_auto glo, 'tn' , w3d, ldxios = lrxios )273 ts n(:,:,1,jp_tem) = w3d(:,:,1)268 & "rst_read:- ln_diurnal_only set, setting rhop=rho0" 269 rhop = rho0 270 CALL iom_get( numror, jpdom_auto, 'tn' , w3d, ldxios = lrxios ) 271 ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1) 274 272 RETURN 275 273 ENDIF 276 274 277 275 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 278 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub, ldxios = lrxios ) ! before fields 279 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb, ldxios = lrxios ) 280 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem), ldxios = lrxios ) 281 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal), ldxios = lrxios ) 282 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb, ldxios = lrxios ) 276 ! before fields 277 CALL iom_get( numror, jpdom_auto, 'ub' , uu(:,:,: ,Kbb), ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) 278 CALL iom_get( numror, jpdom_auto, 'vb' , vv(:,:,: ,Kbb), ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) 279 CALL iom_get( numror, jpdom_auto, 'tb' , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 280 CALL iom_get( numror, jpdom_auto, 'sb' , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 281 CALL iom_get( numror, jpdom_auto, 'sshb' ,ssh(:,: ,Kbb), ldxios = lrxios ) 283 282 ELSE 284 neuler = 0 285 ENDIF 286 ! 287 CALL iom_get( numror, jpdom_autoglo, 'un' , un, ldxios = lrxios ) ! now fields 288 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn, ldxios = lrxios ) 289 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem), ldxios = lrxios ) 290 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal), ldxios = lrxios ) 291 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, ldxios = lrxios ) 283 l_1st_euler = .TRUE. ! before field not found, forced euler 1st time-step 284 ENDIF 285 ! 286 ! now fields 287 CALL iom_get( numror, jpdom_auto, 'un' , uu(:,:,: ,Kmm), ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) 288 CALL iom_get( numror, jpdom_auto, 'vn' , vv(:,:,: ,Kmm), ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) 289 CALL iom_get( numror, jpdom_auto, 'tn' , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 290 CALL iom_get( numror, jpdom_auto, 'sn' , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 291 CALL iom_get( numror, jpdom_auto, 'sshn' ,ssh(:,: ,Kmm), ldxios = lrxios ) 292 292 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 293 CALL iom_get( numror, jpdom_auto glo, 'rhop' , rhop, ldxios = lrxios ) ! now potential density293 CALL iom_get( numror, jpdom_auto, 'rhop' , rhop, ldxios = lrxios ) ! now potential density 294 294 ELSE 295 CALL eos( ts n, rhd, rhop, gdept_n(:,:,:) )295 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) ) 296 296 ENDIF 297 297 IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 298 298 ! 299 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 300 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values 301 ub (:,:,:) = un (:,:,:) 302 vb (:,:,:) = vn (:,:,:) 303 sshb (:,:) = sshn (:,:) 304 ! 305 IF( .NOT.ln_linssh ) THEN 306 DO jk = 1, jpk 307 e3t_b(:,:,jk) = e3t_n(:,:,jk) 308 END DO 309 ENDIF 310 ! 299 IF( l_1st_euler ) THEN ! Euler restart 300 ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm) ! all before fields set to now values 301 uu (:,:,: ,Kbb) = uu (:,:,: ,Kmm) 302 vv (:,:,: ,Kbb) = vv (:,:,: ,Kmm) 303 ssh (:,: ,Kbb) = ssh (:,: ,Kmm) 311 304 ENDIF 312 305 !
Note: See TracChangeset
for help on using the changeset viewer.
