Changeset 473 for trunk/NEMO/OPA_SRC/restart.F90
- Timestamp:
- 2006-05-11T17:04:37+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/restart.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/restart.F90
r467 r473 84 84 CHARACTER (len=50) :: clname, cln 85 85 INTEGER :: ic, jc, itime 86 INTEGER :: inumwrs 86 87 REAL(wp) :: zdate0 87 88 REAL(wp), DIMENSION( 1) :: zfice, zfblk ! used only in case of ice & bulk … … 111 112 IF(lwp) WRITE(numout,*) '~~~~~~~~~' 112 113 113 ! Job informations 114 ! Job informations 115 zinfo(:) = 0.e0 114 116 zinfo(1) = FLOAT( no ) ! job number 115 117 zinfo(2) = FLOAT( kt ) ! time-step … … 132 134 CLOSE( knum, STATUS='delete' ) 133 135 #else 134 OPEN( UNIT= numwrs, FILE=crestart, STATUS='old' )135 CLOSE( numwrs, STATUS='delete' )136 OPEN( UNIT=inumwrs, FILE=crestart, STATUS='old' ) 137 CLOSE( inumwrs, STATUS='delete' ) 136 138 #endif 137 139 ENDIF … … 152 154 CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 ) 153 155 CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept_0, clname, & 154 itime, zdate0, rdt*nstock , numwrs, domain_id=nidom )155 156 CALL restput( numwrs, 'info' , 1 , 1 , 10 , 0, zinfo ) ! restart informations156 itime, zdate0, rdt*nstock ,inumwrs, domain_id=nidom ) 157 158 CALL restput( inumwrs, 'info' , 1 , 1 , 10 , 0, zinfo ) ! restart informations 157 159 158 CALL restput( numwrs, 'ub' , jpi, jpj, jpk, 0, ub ) ! prognostic variables159 CALL restput( numwrs, 'vb' , jpi, jpj, jpk, 0, vb )160 CALL restput( numwrs, 'tb' , jpi, jpj, jpk, 0, tb )161 CALL restput( numwrs, 'sb' , jpi, jpj, jpk, 0, sb )162 CALL restput( numwrs, 'rotb' , jpi, jpj, jpk, 0, rotb )163 CALL restput( numwrs, 'hdivb' , jpi, jpj, jpk, 0, hdivb )164 CALL restput( numwrs, 'un' , jpi, jpj, jpk, 0, un )165 CALL restput( numwrs, 'vn' , jpi, jpj, jpk, 0, vn )166 CALL restput( numwrs, 'tn' , jpi, jpj, jpk, 0, tn )167 CALL restput( numwrs, 'sn' , jpi, jpj, jpk, 0, sn )168 CALL restput( numwrs, 'rotn' , jpi, jpj, jpk, 0, rotn )169 CALL restput( numwrs, 'hdivn' , jpi, jpj, jpk, 0, hdivn )160 CALL restput( inumwrs, 'ub' , jpi, jpj, jpk, 0, ub ) ! prognostic variables 161 CALL restput( inumwrs, 'vb' , jpi, jpj, jpk, 0, vb ) 162 CALL restput( inumwrs, 'tb' , jpi, jpj, jpk, 0, tb ) 163 CALL restput( inumwrs, 'sb' , jpi, jpj, jpk, 0, sb ) 164 CALL restput( inumwrs, 'rotb' , jpi, jpj, jpk, 0, rotb ) 165 CALL restput( inumwrs, 'hdivb' , jpi, jpj, jpk, 0, hdivb ) 166 CALL restput( inumwrs, 'un' , jpi, jpj, jpk, 0, un ) 167 CALL restput( inumwrs, 'vn' , jpi, jpj, jpk, 0, vn ) 168 CALL restput( inumwrs, 'tn' , jpi, jpj, jpk, 0, tn ) 169 CALL restput( inumwrs, 'sn' , jpi, jpj, jpk, 0, sn ) 170 CALL restput( inumwrs, 'rotn' , jpi, jpj, jpk, 0, rotn ) 171 CALL restput( inumwrs, 'hdivn' , jpi, jpj, jpk, 0, hdivn ) 170 172 171 173 ztab(:,:) = gcx(1:jpi,1:jpj) 172 CALL restput( numwrs, 'gcx' , jpi, jpj, 1 , 0, ztab ) ! Read elliptic solver arrays174 CALL restput( inumwrs, 'gcx' , jpi, jpj, 1 , 0, ztab ) ! Read elliptic solver arrays 173 175 ztab(:,:) = gcxb(1:jpi,1:jpj) 174 CALL restput( numwrs, 'gcxb' , jpi, jpj, 1 , 0, ztab )176 CALL restput( inumwrs, 'gcxb' , jpi, jpj, 1 , 0, ztab ) 175 177 # if defined key_dynspg_rl 176 CALL restput( numwrs, 'bsfb' , jpi, jpj, 1 , 0, bsfb ) ! Rigid-lid formulation (bsf)177 CALL restput( numwrs, 'bsfn' , jpi, jpj, 1 , 0, bsfn )178 CALL restput( numwrs, 'bsfd' , jpi, jpj, 1 , 0, bsfd )178 CALL restput( inumwrs, 'bsfb' , jpi, jpj, 1 , 0, bsfb ) ! Rigid-lid formulation (bsf) 179 CALL restput( inumwrs, 'bsfn' , jpi, jpj, 1 , 0, bsfn ) 180 CALL restput( inumwrs, 'bsfd' , jpi, jpj, 1 , 0, bsfd ) 179 181 # else 180 CALL restput( numwrs, 'sshb' , jpi, jpj, 1 , 0, sshb ) ! free surface formulation (ssh)181 CALL restput( numwrs, 'sshn' , jpi, jpj, 1 , 0, sshn )182 CALL restput( inumwrs, 'sshb' , jpi, jpj, 1 , 0, sshb ) ! free surface formulation (ssh) 183 CALL restput( inumwrs, 'sshn' , jpi, jpj, 1 , 0, sshn ) 182 184 # if defined key_dynspg_ts 183 CALL restput( numwrs, 'sshb_b' , jpi, jpj, 1 , 0, sshb_b ) ! free surface formulation (ssh)184 CALL restput( numwrs, 'sshn_b' , jpi, jpj, 1 , 0, sshn_b ) ! issued from barotropic loop185 CALL restput( numwrs, 'un_b' , jpi, jpj, 1 , 0, un_b ) ! horizontal transports186 CALL restput( numwrs, 'vn_b' , jpi, jpj, 1 , 0, vn_b ) ! issued from barotropic loop185 CALL restput( inumwrs, 'sshb_b' , jpi, jpj, 1 , 0, sshb_b ) ! free surface formulation (ssh) 186 CALL restput( inumwrs, 'sshn_b' , jpi, jpj, 1 , 0, sshn_b ) ! issued from barotropic loop 187 CALL restput( inumwrs, 'un_b' , jpi, jpj, 1 , 0, un_b ) ! horizontal transports 188 CALL restput( inumwrs, 'vn_b' , jpi, jpj, 1 , 0, vn_b ) ! issued from barotropic loop 187 189 # endif 188 190 # endif 189 191 # if defined key_zdftke || defined key_esopa 190 192 IF( lk_zdftke ) THEN 191 CALL restput( numwrs, 'en' , jpi, jpj, jpk, 0, en ) ! TKE arrays193 CALL restput( inumwrs, 'en' , jpi, jpj, jpk, 0, en ) ! TKE arrays 192 194 ENDIF 193 195 # endif 194 196 # if defined key_ice_lim 195 197 zfice(1) = FLOAT( nfice ) ! Louvain La Neuve Sea Ice Model 196 CALL restput( numwrs, 'nfice' , 1, 1, 1 , 0, zfice )197 CALL restput( numwrs, 'sst_io' , jpi, jpj, 1 , 0, sst_io )198 CALL restput( numwrs, 'sss_io' , jpi, jpj, 1 , 0, sss_io )199 CALL restput( numwrs, 'u_io' , jpi, jpj, 1 , 0, u_io )200 CALL restput( numwrs, 'v_io' , jpi, jpj, 1 , 0, v_io )198 CALL restput( inumwrs, 'nfice' , 1, 1, 1 , 0, zfice ) 199 CALL restput( inumwrs, 'sst_io' , jpi, jpj, 1 , 0, sst_io ) 200 CALL restput( inumwrs, 'sss_io' , jpi, jpj, 1 , 0, sss_io ) 201 CALL restput( inumwrs, 'u_io' , jpi, jpj, 1 , 0, u_io ) 202 CALL restput( inumwrs, 'v_io' , jpi, jpj, 1 , 0, v_io ) 201 203 # if defined key_coupled 202 CALL restput( numwrs, 'alb_ice', jpi, jpj, 1 , 0, alb_ice )204 CALL restput( inumwrs, 'alb_ice', jpi, jpj, 1 , 0, alb_ice ) 203 205 # endif 204 206 # endif 205 207 # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 206 208 zfblk(1) = FLOAT( nfbulk ) ! Bulk 207 CALL restput( numwrs, 'nfbulk' , 1, 1, 1 , 0, zfblk )208 CALL restput( numwrs, 'gsst' , jpi, jpj, 1 , 0, gsst )209 # endif 210 211 CALL restclo( numwrs ) ! close the restart file209 CALL restput( inumwrs, 'nfbulk' , 1, 1, 1 , 0, zfblk ) 210 CALL restput( inumwrs, 'gsst' , jpi, jpj, 1 , 0, gsst ) 211 # endif 212 213 CALL restclo( inumwrs ) ! close the restart file 212 214 213 215 ENDIF … … 251 253 !!---------------------------------------------------------------------- 252 254 !! * Modules used 253 USE io ipsl255 USE iom 254 256 255 257 !! * Local declarations 256 LOGICAL :: llog257 CHARACTER (len=8 ) :: clvnames(50)258 CHARACTER (len=32) :: clname259 258 INTEGER :: & 260 itime, ibvar, & !261 259 inum ! temporary logical unit 262 REAL(wp) :: zdate0, zdt, zinfo(10)263 REAL(wp) :: zdept(jpk), zlamt(jpi,jpj), zphit(jpi,jpj)264 REAL(wp), DIMENSION(jpi,jpj) :: ztab260 REAL(wp), DIMENSION(1, 1, 10) :: zinfo 261 REAL(wp), DIMENSION(1, 1, 1) :: zzz 262 INTEGER :: ios 265 263 # if defined key_ice_lim 266 INTEGER :: ios1, ji, jj, jn 267 REAL(wp) :: zfice(1) 268 # endif 269 # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 270 INTEGER :: ios2, jk 271 REAL(wp) :: zfblk(1) 264 INTEGER :: ji, jj 272 265 # endif 273 266 !!---------------------------------------------------------------------- 274 !! OPA 8.5, LODYC-IPSL (2002)275 !!----------------------------------------------------------------------276 clname = 'restart'277 #if defined key_agrif278 inum = Agrif_Get_Unit()279 If(.NOT. Agrif_root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)280 #endif281 267 282 268 IF(lwp) WRITE(numout,*) … … 314 300 END SELECT 315 301 316 itime = 0 317 llog = .FALSE. 318 zlamt(:,:) = 0.e0 319 zphit(:,:) = 0.e0 320 zdept(:) = 0.e0 321 CALL restini( clname, jpi, jpj, zlamt, zphit, jpk, zdept, 'NONE', & 322 & itime, zdate0, zdt, inum, domain_id=nidom ) 323 324 CALL ioget_vname( inum, ibvar, clvnames) 325 CALL restget( inum, 'info', 1, 1, 10, 0, llog, zinfo ) 326 302 CALL iom_open ( 'restart', inum ) 303 304 CALL iom_get ( inum, jpdom_unknown, 'info', zinfo ) 305 327 306 IF(lwp) WRITE(numout,*) 328 307 IF(lwp) WRITE(numout,*) ' Info on the restart file read : ' 329 IF(lwp) WRITE(numout,*) ' FILE name : ', clname 330 IF(lwp) WRITE(numout,*) ' job number : ', NINT( zinfo(1) ) 331 IF(lwp) WRITE(numout,*) ' time-step : ', NINT( zinfo(2) ) 332 IF(lwp) WRITE(numout,*) ' solver type : ', NINT( zinfo(4) ) + 1 333 IF(lwp) WRITE(numout,*) ' tke option : ', NINT( zinfo(5) ) 334 IF(lwp) WRITE(numout,*) ' date ndastp : ', NINT( zinfo(6) ) 335 IF(lwp) WRITE(numout,*) ' number of variables : ', ibvar 336 IF(lwp) WRITE(numout,*) ' NetCDF variables : ', clvnames(1:ibvar) 308 IF(lwp) WRITE(numout,*) ' job number : ', NINT( zinfo(1, 1, 1) ) 309 IF(lwp) WRITE(numout,*) ' time-step : ', NINT( zinfo(1, 1, 2) ) 310 IF(lwp) WRITE(numout,*) ' solver type : ', NINT( zinfo(1, 1, 4) ) + 1 311 IF(lwp) WRITE(numout,*) ' tke option : ', NINT( zinfo(1, 1, 5) ) 312 IF(lwp) WRITE(numout,*) ' date ndastp : ', NINT( zinfo(1, 1, 6) ) 337 313 IF(lwp) WRITE(numout,*) 338 314 339 315 ! Control of date 340 IF( nit000 - NINT( zinfo(2) ) /= 1 .AND. nrstdt /= 0 ) THEN 341 IF(lwp) WRITE(numout,cform_err) 342 IF(lwp) WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart' 343 IF(lwp) WRITE(numout,*) ' verify the restart file or rerun with nrstdt = 0 (namelist)' 344 nstop = nstop + 1 345 ENDIF 316 IF( nit000 - NINT( zinfo(1, 1, 2) ) /= 1 .AND. nrstdt /= 0 ) & 317 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 318 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 346 319 347 320 ! re-initialisation of adatrj0 … … 352 325 ! ndate0 has been read in the namelist (standard OPA 8) 353 326 ! here when nrstdt=2 we keep the final date of previous run 354 ndastp = NINT( zinfo(6) ) 355 adatrj0 = zinfo(7) 356 ENDIF 357 358 359 360 CALL restget( inum, 'ub' , jpi, jpj, jpk, 0, llog, ub ) ! Read prognostic variables 361 CALL restget( inum, 'vb' , jpi, jpj, jpk, 0, llog, vb ) 362 CALL restget( inum, 'tb' , jpi, jpj, jpk, 0, llog, tb ) 363 CALL restget( inum, 'sb' , jpi, jpj, jpk, 0, llog, sb ) 364 CALL restget( inum, 'rotb' , jpi, jpj, jpk, 0, llog, rotb ) 365 CALL restget( inum, 'hdivb' , jpi, jpj, jpk, 0, llog, hdivb ) 366 CALL restget( inum, 'un' , jpi, jpj, jpk, 0, llog, un ) 367 CALL restget( inum, 'vn' , jpi, jpj, jpk, 0, llog, vn ) 368 CALL restget( inum, 'tn' , jpi, jpj, jpk, 0, llog, tn ) 369 CALL restget( inum, 'sn' , jpi, jpj, jpk, 0, llog, sn ) 370 CALL restget( inum, 'rotn' , jpi, jpj, jpk, 0, llog, rotn ) 371 CALL restget( inum, 'hdivn' , jpi, jpj, jpk, 0, llog, hdivn ) 372 373 CALL restget( inum, 'gcxb' , jpi, jpj, 1 , 0, llog, ztab ) ! Read elliptic solver arrays 374 gcxb(1:jpi,1:jpj) = ztab(:,:) 375 CALL restget( inum, 'gcx' , jpi, jpj, 1 , 0, llog, ztab ) 376 gcx(1:jpi,1:jpj) = ztab(:,:) 327 ndastp = NINT( zinfo(1, 1, 6) ) 328 adatrj0 = zinfo(1, 1, 7) 329 ENDIF 330 331 CALL iom_get( inum, jpdom_local, 'ub' , ub ) ! Read prognostic variables 332 CALL iom_get( inum, jpdom_local, 'vb' , vb ) 333 CALL iom_get( inum, jpdom_local, 'tb' , tb ) 334 CALL iom_get( inum, jpdom_local, 'sb' , sb ) 335 CALL iom_get( inum, jpdom_local, 'rotb' , rotb ) 336 CALL iom_get( inum, jpdom_local, 'hdivb', hdivb ) 337 CALL iom_get( inum, jpdom_local, 'un' , un ) 338 CALL iom_get( inum, jpdom_local, 'vn' , vn ) 339 CALL iom_get( inum, jpdom_local, 'tn' , tn ) 340 CALL iom_get( inum, jpdom_local, 'sn' , sn ) 341 CALL iom_get( inum, jpdom_local, 'rotn' , rotn ) 342 CALL iom_get( inum, jpdom_local, 'hdivn', hdivn ) 343 ! Caution : extrahallow 344 ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 345 CALL iom_get( inum, jpdom_local, 'gcx' , gcx (1:jpi,1:jpj) ) 346 CALL iom_get( inum, jpdom_local, 'gcxb', gcxb(1:jpi,1:jpj) ) ! Read elliptic solver arrays 377 347 # if defined key_dynspg_rl 378 CALL restget( inum, 'bsfb' , jpi, jpj, 1 , 0, llog, bsfb )! Rigid-lid formulation (bsf)379 CALL restget( inum, 'bsfn' , jpi, jpj, 1 , 0, llog, bsfn)380 CALL restget( inum, 'bsfd' , jpi, jpj, 1 , 0, llog, bsfd)348 CALL iom_get( inum, jpdom_local, 'bsfb', bsfb ) ! Rigid-lid formulation (bsf) 349 CALL iom_get( inum, jpdom_local, 'bsfn', bsfn ) 350 CALL iom_get( inum, jpdom_local, 'bsfd', bsfd ) 381 351 # else 382 CALL restget( inum, 'sshb' , jpi, jpj, 1 , 0, llog, sshb )! free surface formulation (ssh)383 CALL restget( inum, 'sshn' , jpi, jpj, 1 , 0, llog, sshn)352 CALL iom_get( inum, jpdom_local, 'sshb', sshb ) ! free surface formulation (ssh) 353 CALL iom_get( inum, jpdom_local, 'sshn', sshn ) 384 354 # if defined key_dynspg_ts 385 CALL restget( inum, 'sshb_b' , jpi, jpj, 1 , 0, llog, sshb_b )! free surface formulation (ssh)386 CALL restget( inum, 'sshn_b' , jpi, jpj, 1 , 0, llog, sshn_b )! issued from barotropic loop387 CALL restget( inum, 'un_b' , jpi, jpj, 1 , 0, llog, un_b) ! horizontal transports388 CALL restget( inum, 'vn_b' , jpi, jpj, 1 , 0, llog, vn_b) ! issued from barotropic loop355 CALL iom_get( inum, jpdom_local, 'sshb_b', sshb_b ) ! free surface formulation (ssh) 356 CALL iom_get( inum, jpdom_local, 'sshn_b', sshn_b ) ! issued from barotropic loop 357 CALL iom_get( inum, jpdom_local, 'un_b' , un_b ) ! horizontal transports 358 CALL iom_get( inum, jpdom_local, 'vn_b' , vn_b ) ! issued from barotropic loop 389 359 # endif 390 360 # endif 391 361 # if defined key_zdftke || defined key_esopa 392 362 IF( lk_zdftke ) THEN 393 IF( NINT( zinfo( 5) ) == 1 ) THEN ! Read tke arrays394 CALL restget( inum, 'en',jpi,jpj, jpk,0 , llog, en )363 IF( NINT( zinfo(1, 1, 5) ) == 1 ) THEN ! Read tke arrays 364 CALL iom_get( inum, jpdom_local, 'en', en ) 395 365 ln_rstke = .FALSE. 396 366 ELSE 397 IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file did not used tke scheme'367 IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file did not used tke scheme' 398 368 IF(lwp) WRITE(numout,*) ' ======= =======' 399 369 nrstdt = 2 … … 404 374 # if defined key_ice_lim 405 375 ! Louvain La Neuve Sea Ice Model 406 ios1 = 0 407 DO jn = 1, 30 408 IF( clvnames(jn) == 'nfice' ) ios1 = 1 409 END DO 410 IF( ios1 == 1 ) THEN 411 CALL restget( inum, 'nfice' , 1, 1, 1 , 0, llog, zfice ) 412 CALL restget( inum, 'sst_io', jpi, jpj, 1 , 0, llog, sst_io ) 413 CALL restget( inum, 'sss_io', jpi, jpj, 1 , 0, llog, sss_io ) 414 CALL restget( inum, 'u_io' , jpi, jpj, 1 , 0, llog, u_io ) 415 CALL restget( inum, 'v_io' , jpi, jpj, 1 , 0, llog, v_io ) 376 ios = iom_varid( inum, 'nfice' ) 377 IF( ios > 0 ) then 378 CALL iom_get( inum, jpdom_unknown, 'nfice' , zzz ) 379 zinfo(1, 1, 8) = zzz(1, 1, 1) 380 CALL iom_get( inum, jpdom_local, 'sst_io', sst_io ) 381 CALL iom_get( inum, jpdom_local, 'sss_io', sss_io ) 382 CALL iom_get( inum, jpdom_local, 'u_io' , u_io ) 383 CALL iom_get( inum, jpdom_local, 'v_io' , v_io ) 416 384 #if defined key_coupled 417 CALL restget( inum, 'alb_ice', jpi, jpj, 1 , 0, llog, alb_ice )385 CALL iom_get( inum, jpdom_local, 'alb_ice', alb_ice ) 418 386 #endif 419 387 ENDIF 420 IF( z fice(1) /= FLOAT(nfice) .OR. ios1== 0 ) THEN388 IF( zinfo(1, 1, 8) /= FLOAT(nfice) .OR. ios == 0 ) THEN 421 389 IF(lwp) WRITE(numout,*) 422 390 IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization' … … 437 405 # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 438 406 ! Louvain La Neuve Sea Ice Model 439 ios2 = 0 440 DO jk = 1, 30 441 IF( clvnames(jk) == 'nfbulk' ) ios2 = 1 442 END DO 443 IF( ios2 == 1 ) THEN 444 CALL restget( inum, 'nfbulk', 1, 1, 1 , 0, llog, zfblk ) 445 CALL restget( inum, 'gsst' , jpi, jpj, 1 , 0, llog, gsst ) 446 ENDIF 447 IF( zfblk(1) /= FLOAT(nfbulk) .OR. ios2 == 0 ) THEN 407 ios = iom_varid( inum, 'nfbulk' ) 408 IF( ios > 0 ) then 409 CALL iom_get( inum, jpdom_unknown, 'nfbulk' , zzz ) 410 CALL iom_get( inum, jpdom_local, 'gsst' , gsst ) 411 zinfo(1, 1, 9) = zzz(1, 1, 1) 412 ENDIF 413 IF( zinfo(1, 1, 9) /= FLOAT(nfbulk) .OR. ios == 0 ) THEN 448 414 IF(lwp) WRITE(numout,*) 449 415 IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization' … … 454 420 # endif 455 421 456 CALL restclo( inum ) 422 CALL iom_close( inum ) 423 457 424 ! In case of restart with neuler = 0 then put all before fields = to now fields 458 425 IF ( neuler == 0 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
