Changeset 508 for trunk/NEMO/OPA_SRC/restart.F90
- Timestamp:
- 2006-10-03T17:58:55+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/restart.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/restart.F90
r473 r508 3 3 !! *** MODULE restart *** 4 4 !! Ocean restart : write the ocean restart file 5 !!===================================================================== 6 7 !!---------------------------------------------------------------------- 8 !! rst_write : write of the restart file 9 !! rst_read : read the restart file 10 !!---------------------------------------------------------------------- 11 !! * Modules used 5 !!====================================================================== 6 !! History : ! 99-11 (M. Imbard) Original code 7 !! 8.5 ! 02-08 (G. Madec) F90: Free form 8 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 9 !! 9.0 ! 06-07 (S. Masson) use IOM for restart 10 !!---------------------------------------------------------------------- 11 12 !!---------------------------------------------------------------------- 13 !! rst_opn : open the ocean restart file 14 !! rst_write : write the ocean restart file 15 !! rst_read : read the ocean restart file 16 !!---------------------------------------------------------------------- 12 17 USE dom_oce ! ocean space and time domain 13 18 USE oce ! ocean dynamics and tracers 14 19 USE phycst ! physical constants 15 USE in_out_manager ! I/O manager16 20 USE daymod ! calendar 17 USE sol_oce ! ocean elliptic solver18 USE zdf_oce ! ???19 USE zdftke ! turbulent kinetic energy scheme20 21 USE ice_oce ! ice variables 21 22 USE blk_oce ! bulk variables 22 USE flx_oce ! sea-ice/ocean forcings variables23 USE dynspg_oce ! free surface time splitting scheme variables24 23 USE cpl_oce, ONLY : lk_cpl ! 24 USE in_out_manager ! I/O manager 25 USE iom ! I/O module 25 26 26 27 IMPLICIT NONE 27 28 PRIVATE 28 29 29 !! * Routine accessibility 30 PUBLIC rst_write ! routine called by step.F90 31 PUBLIC rst_read ! routine called by inidtr.F90 32 33 !! * Module variables 34 CHARACTER (len=48) :: & 35 crestart = 'initial.nc' ! restart file name 36 !!---------------------------------------------------------------------- 37 !! OPA 9.0 , LOCEAN-IPSL (2005) 30 PUBLIC rst_opn ! routine called by step module 31 PUBLIC rst_write ! routine called by step module 32 PUBLIC rst_read ! routine called by opa module 33 34 LOGICAL, PUBLIC :: lrst_oce !: logical to control the oce restart write 35 INTEGER, PUBLIC :: nitrst !: time step at which restart file should be written 36 INTEGER, PUBLIC :: numror, numrow !: logical unit for cean restart (read and write) 37 38 !! * Substitutions 39 # include "vectopt_loop_substitute.h90" 40 !!---------------------------------------------------------------------- 41 !! OPA 9.0 , LOCEAN-IPSL (2006) 38 42 !! $Header$ 39 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 40 !!---------------------------------------------------------------------- 41 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 44 !!---------------------------------------------------------------------- 42 45 43 46 CONTAINS 47 48 SUBROUTINE rst_opn( kt ) 49 !!--------------------------------------------------------------------- 50 !! *** ROUTINE rst_opn *** 51 !! 52 !! ** Purpose : + initialization (should be read in the namelist) of nitrst 53 !! + open the restart when we are one time step before nitrst 54 !! - restart header is defined when kt = nitrst-1 55 !! - restart data are written when kt = nitrst 56 !! + define lrst_oce to .TRUE. when we need to define or write the restart 57 !!---------------------------------------------------------------------- 58 INTEGER, INTENT(in) :: kt ! ocean time-step 59 !! 60 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 61 CHARACTER(LEN=50) :: clname ! ice output restart file name 62 !!---------------------------------------------------------------------- 63 ! 64 IF( kt == nit000 ) THEN ! default initialization, to do: should be read in the namelist... 65 nitrst = nitend ! to do: should be read in the namelist in a cleaver way... 66 lrst_oce = .FALSE. 67 ENDIF 68 69 IF ( kt == nitrst-1 .AND. lrst_oce ) THEN 70 CALL ctl_stop( 'rst_opn: we cannot create an ocean restart at every time step' ) 71 numrow = 0 72 ELSEIF( kt == nitrst-1 .OR. nitend == nit000 ) THEN ! beware if model runs only one time step 73 ! beware of the format used to write kt (default is i8.8, that should be large enough) 74 IF( nitrst > 1.0e9 ) THEN 75 WRITE(clkt,*) nitrst 76 ELSE 77 WRITE(clkt,'(i8.8)') nitrst 78 ENDIF 79 ! create the file 80 IF(lwp) WRITE(numout,*) 81 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart" 82 IF(lwp) WRITE(numout,*) ' open ocean restart.output NetCDF file: '//clname 83 CALL iom_open( clname, numrow, ldwrt = .TRUE. ) 84 lrst_oce = .TRUE. 85 ENDIF 86 ! 87 END SUBROUTINE rst_opn 88 44 89 45 90 #if ( defined key_mpp_mpi || defined key_mpp_shmem ) && defined key_dimgout … … 66 111 !! ** Purpose : Write restart fields in NetCDF format 67 112 !! 68 !! ** Method : Write in num wrs file each nstock time stepin NetCDF113 !! ** Method : Write in numrow when kt == nitrst in NetCDF 69 114 !! file, save fields which are necessary for restart 70 !! 71 !! History : 72 !! ! 99-11 (M. Imbard) Original code 73 !! 8.5 ! 02-08 (G. Madec) F90: Free form 74 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 75 !!---------------------------------------------------------------------- 76 !! * Modules used 77 USE ioipsl 78 79 !! * Arguments 80 INTEGER, INTENT( in ) :: kt ! ocean time-step 81 82 !! * Local declarations 83 LOGICAL :: llbon 84 CHARACTER (len=50) :: clname, cln 85 INTEGER :: ic, jc, itime 86 INTEGER :: inumwrs 87 REAL(wp) :: zdate0 88 REAL(wp), DIMENSION( 1) :: zfice, zfblk ! used only in case of ice & bulk 89 REAL(wp), DIMENSION(10) :: zinfo(10) 90 REAL(wp), DIMENSION(jpi,jpj) :: ztab 91 #if defined key_agrif 92 Integer :: knum 93 #endif 94 !!---------------------------------------------------------------------- 95 96 IF( kt == nit000 ) THEN 97 IF(lwp) WRITE(numout,*) 98 IF(lwp) WRITE(numout,*) 'rst_wri : write restart.output NetCDF file' 99 IF(lwp) WRITE(numout,*) '~~~~~~~' 100 zfice(1) = 1.e0 ; zfblk(1) = 1.e0 101 ENDIF 102 103 104 IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN 105 106 ! 0. Initializations 107 ! ------------------ 108 109 IF(lwp) WRITE(numout,*) ' ' 110 IF(lwp) WRITE(numout,*) 'rst_write : write the restart file in NetCDF format ', & 111 'at it= ',kt,' date= ',ndastp 112 IF(lwp) WRITE(numout,*) '~~~~~~~~~' 113 114 ! Job informations 115 zinfo(:) = 0.e0 116 zinfo(1) = FLOAT( no ) ! job number 117 zinfo(2) = FLOAT( kt ) ! time-step 118 zinfo(3) = FLOAT( 2 - nsolv ) ! pcg solver 119 zinfo(4) = FLOAT( nsolv - 1 ) ! sor solver 120 IF( lk_zdftke ) THEN 121 zinfo(5) = 1.e0 ! TKE 122 ELSE 123 zinfo(5) = 0.e0 ! no TKE 124 ENDIF 125 zinfo(6) = FLOAT( ndastp ) ! date 126 zinfo(7) = adatrj ! ??? 127 128 ! delete the restart file if it exists 129 INQUIRE( FILE=crestart, EXIST=llbon ) 130 IF(llbon) THEN 131 #if defined key_agrif 132 knum =Agrif_Get_Unit() 133 OPEN( UNIT=knum, FILE=crestart, STATUS='old' ) 134 CLOSE( knum, STATUS='delete' ) 135 #else 136 OPEN( UNIT=inumwrs, FILE=crestart, STATUS='old' ) 137 CLOSE( inumwrs, STATUS='delete' ) 138 #endif 139 ENDIF 140 141 ! Name of the new restart file 142 ic = 1 143 DO jc = 1, 16 144 IF( cexper(jc:jc) /= ' ' ) ic = jc 145 END DO 146 WRITE(cln,'("_",i4.4,i2.2,i2.2,"_restart")') nyear, nmonth, nday 147 clname = cexper(1:ic)//cln 148 ic = 1 149 DO jc = 1, 48 150 IF( clname(jc:jc) /= ' ' ) ic = jc 151 END DO 152 crestart = clname(1:ic)//".nc" 153 itime = 0 154 CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 ) 155 CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept_0, clname, & 156 itime, zdate0, rdt*nstock ,inumwrs, domain_id=nidom ) 157 158 CALL restput( inumwrs, 'info' , 1 , 1 , 10 , 0, zinfo ) ! restart informations 159 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 ) 172 173 ztab(:,:) = gcx(1:jpi,1:jpj) 174 CALL restput( inumwrs, 'gcx' , jpi, jpj, 1 , 0, ztab ) ! Read elliptic solver arrays 175 ztab(:,:) = gcxb(1:jpi,1:jpj) 176 CALL restput( inumwrs, 'gcxb' , jpi, jpj, 1 , 0, ztab ) 177 # if defined key_dynspg_rl 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 ) 181 # else 182 CALL restput( inumwrs, 'sshb' , jpi, jpj, 1 , 0, sshb ) ! free surface formulation (ssh) 183 CALL restput( inumwrs, 'sshn' , jpi, jpj, 1 , 0, sshn ) 184 # if defined key_dynspg_ts 185 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 115 !!---------------------------------------------------------------------- 116 INTEGER, INTENT(in) :: kt ! ocean time-step 117 !!---------------------------------------------------------------------- 118 119 IF(lwp) THEN 120 WRITE(numout,*) 121 WRITE(numout,*) 'rst_write : write ocean NetCDF restart file kt =', kt,' date= ', ndastp 122 WRITE(numout,*) '~~~~~~~~~' 123 ENDIF 124 125 ! calendar control 126 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 127 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date 128 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since 129 ! ! the begining of the run [s] 130 131 ! prognostic variables 132 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub ) 133 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb ) 134 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tb ) 135 CALL iom_rstput( kt, nitrst, numrow, 'sb' , sb ) 136 CALL iom_rstput( kt, nitrst, numrow, 'rotb' , rotb ) 137 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb ) 138 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) 139 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn ) 140 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tn ) 141 CALL iom_rstput( kt, nitrst, numrow, 'sn' , sn ) 142 CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn ) 143 CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn ) 144 145 # if defined key_ice_lim 146 CALL iom_rstput( kt, nitrst, numrow, 'nfice' , REAL( nfice, wp) ) ! ice computation frequency 147 CALL iom_rstput( kt, nitrst, numrow, 'sst_io' , sst_io ) 148 CALL iom_rstput( kt, nitrst, numrow, 'sss_io' , sss_io ) 149 CALL iom_rstput( kt, nitrst, numrow, 'u_io' , u_io ) 150 CALL iom_rstput( kt, nitrst, numrow, 'v_io' , v_io ) 151 # if defined key_coupled 152 CALL iom_rstput( kt, nitrst, numrow, 'alb_ice', alb_ice ) 189 153 # endif 190 154 # endif 191 # if defined key_zdftke || defined key_esopa192 IF( lk_zdftke ) THEN193 CALL restput( inumwrs, 'en' , jpi, jpj, jpk, 0, en ) ! TKE arrays194 ENDIF195 # endif196 # if defined key_ice_lim197 zfice(1) = FLOAT( nfice ) ! Louvain La Neuve Sea Ice Model198 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 )203 # if defined key_coupled204 CALL restput( inumwrs, 'alb_ice', jpi, jpj, 1 , 0, alb_ice )205 # endif206 # endif207 155 # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 208 zfblk(1) = FLOAT( nfbulk ) ! Bulk209 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 file214 215 ENDIF 216 156 CALL iom_rstput( kt, nitrst, numrow, 'nfbulk' , REAL( nfbulk, wp) ) ! bulk computation frequency 157 CALL iom_rstput( kt, nitrst, numrow, 'gsst' , gsst ) 158 # endif 159 160 IF( kt == nitrst ) THEN 161 CALL iom_close( numrow ) ! close the restart file (only at last time step) 162 lrst_oce = .FALSE. 163 ENDIF 164 ! 217 165 END SUBROUTINE rst_write 218 166 … … 246 194 !! nrstdt = 2 the duration of the experiment in days (adatrj) 247 195 !! has been stored in the restart file. 248 !! 249 !! History : 250 !! ! 99-05 (M. Imbard) Original code 251 !! 8.5 ! 02-09 (G. Madec) F90: Free form 252 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 253 !!---------------------------------------------------------------------- 254 !! * Modules used 255 USE iom 256 257 !! * Local declarations 258 INTEGER :: & 259 inum ! temporary logical unit 260 REAL(wp), DIMENSION(1, 1, 10) :: zinfo 261 REAL(wp), DIMENSION(1, 1, 1) :: zzz 262 INTEGER :: ios 263 # if defined key_ice_lim 196 !!---------------------------------------------------------------------- 197 REAL(wp) :: zcoef, zkt, zndastp, znfice, znfbulk 198 # if defined key_ice_lim 264 199 INTEGER :: ji, jj 265 # endif 266 !!---------------------------------------------------------------------- 267 268 IF(lwp) WRITE(numout,*) 269 IF(lwp) WRITE(numout,*) 'rst_read : read the NetCDF restart file' 270 IF(lwp) WRITE(numout,*) '~~~~~~~~' 271 272 IF(lwp) WRITE(numout,*) ' Info on the present job : ' 273 IF(lwp) WRITE(numout,*) ' job number : ', no 274 IF(lwp) WRITE(numout,*) ' time-step : ', nit000 275 IF(lwp) WRITE(numout,*) ' solver type : ', nsolv 276 IF( lk_zdftke ) THEN 277 IF(lwp) WRITE(numout,*) ' tke option : 1 ' 278 ELSE 279 IF(lwp) WRITE(numout,*) ' tke option : 0 ' 280 ENDIF 281 IF(lwp) WRITE(numout,*) ' date ndastp : ', ndastp 282 IF(lwp) WRITE(numout,*) 283 284 ! Time domain : restart 285 ! ------------------------- 286 287 IF(lwp) WRITE(numout,*) 288 IF(lwp) WRITE(numout,*) 289 IF(lwp) WRITE(numout,*) ' *** restart option' 290 SELECT CASE ( nrstdt ) 291 CASE ( 0 ) 292 IF(lwp) WRITE(numout,*) ' nrstdt = 0 no control of nit000' 293 CASE ( 1 ) 294 IF(lwp) WRITE(numout,*) ' nrstdt = 1 we control the date of nit000' 295 CASE ( 2 ) 296 IF(lwp) WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file' 297 CASE DEFAULT 298 IF(lwp) WRITE(numout,*) ' ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date' 299 IF(lwp) WRITE(numout,*) ' ======= =========' 300 END SELECT 301 302 CALL iom_open ( 'restart', inum ) 303 304 CALL iom_get ( inum, jpdom_unknown, 'info', zinfo ) 305 306 IF(lwp) WRITE(numout,*) 307 IF(lwp) WRITE(numout,*) ' Info on the restart file read : ' 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) ) 313 IF(lwp) WRITE(numout,*) 314 200 # endif 201 !!---------------------------------------------------------------------- 202 203 IF(lwp) THEN ! Contol prints 204 WRITE(numout,*) 205 WRITE(numout,*) 'rst_read : read oce NetCDF restart file' 206 WRITE(numout,*) '~~~~~~~~' 207 208 WRITE(numout,*) ' *** Info on the present job : ' 209 WRITE(numout,*) ' time-step : ', nit000 210 !!$ WRITE(numout,*) ' solver type : ', nsolv 211 !!$ IF( lk_zdftke ) THEN 212 !!$ WRITE(numout,*) ' tke option : 1 ' 213 !!$ ELSE 214 !!$ WRITE(numout,*) ' tke option : 0 ' 215 !!$ ENDIF 216 WRITE(numout,*) ' date ndastp : ', ndastp 217 WRITE(numout,*) 218 WRITE(numout,*) ' *** restart option' 219 SELECT CASE ( nrstdt ) 220 CASE ( 0 ) 221 WRITE(numout,*) ' nrstdt = 0 no control of nit000' 222 CASE ( 1 ) 223 WRITE(numout,*) ' nrstdt = 1 we control the date of nit000' 224 CASE ( 2 ) 225 WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file' 226 CASE DEFAULT 227 WRITE(numout,*) ' ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date' 228 WRITE(numout,*) ' ======= =========' 229 END SELECT 230 WRITE(numout,*) 231 ENDIF 232 233 CALL iom_open( 'restart', numror ) ! Open 234 235 ! Calendar informations 236 CALL iom_get( numror, 'kt' , zkt ) ! time-step 237 CALL iom_get( numror, 'ndastp', zndastp ) ! date 238 ! Additional contol prints 239 IF(lwp) THEN 240 WRITE(numout,*) 241 WRITE(numout,*) ' *** Info on the restart file read : ' 242 WRITE(numout,*) ' time-step : ', NINT( zkt ) 243 !!$ WRITE(numout,*) ' solver type : ', +++ 244 !!$ WRITE(numout,*) ' tke option : ', +++ 245 WRITE(numout,*) ' date ndastp : ', NINT( zndastp ) 246 WRITE(numout,*) 247 ENDIF 315 248 ! Control of date 316 IF( nit000 - NINT( z info(1, 1, 2)) /= 1 .AND. nrstdt /= 0 ) &249 IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) & 317 250 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 318 251 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 319 320 252 ! re-initialisation of adatrj0 321 adatrj0 = ( FLOAT( nit000-1 ) * rdttra(1) ) / rday 322 253 adatrj0 = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 323 254 IF ( nrstdt == 2 ) THEN 324 255 ! by default ndatsp has been set to ndate0 in dom_nam 325 256 ! ndate0 has been read in the namelist (standard OPA 8) 326 257 ! here when nrstdt=2 we keep the final date of previous run 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 347 # if defined key_dynspg_rl 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 ) 351 # else 352 CALL iom_get( inum, jpdom_local, 'sshb', sshb ) ! free surface formulation (ssh) 353 CALL iom_get( inum, jpdom_local, 'sshn', sshn ) 354 # if defined key_dynspg_ts 355 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 359 # endif 360 # endif 361 # if defined key_zdftke || defined key_esopa 362 IF( lk_zdftke ) THEN 363 IF( NINT( zinfo(1, 1, 5) ) == 1 ) THEN ! Read tke arrays 364 CALL iom_get( inum, jpdom_local, 'en', en ) 365 ln_rstke = .FALSE. 366 ELSE 367 IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file did not used tke scheme' 368 IF(lwp) WRITE(numout,*) ' ======= =======' 369 nrstdt = 2 370 ln_rstke = .TRUE. 371 ENDIF 372 ENDIF 373 # endif 258 ndastp = NINT( zndastp ) 259 CALL iom_get( numror, 'adatrj', adatrj ) ! number of elapsed days since the begining of last run 260 ENDIF 261 262 ! ! Read prognostic variables 263 CALL iom_get( numror, jpdom_local, 'ub' , ub ) ! before i-component velocity 264 CALL iom_get( numror, jpdom_local, 'vb' , vb ) ! before j-component velocity 265 CALL iom_get( numror, jpdom_local, 'tb' , tb ) ! before temperature 266 CALL iom_get( numror, jpdom_local, 'sb' , sb ) ! before salinity 267 CALL iom_get( numror, jpdom_local, 'rotb' , rotb ) ! before curl 268 CALL iom_get( numror, jpdom_local, 'hdivb', hdivb ) ! before horizontal divergence 269 CALL iom_get( numror, jpdom_local, 'un' , un ) ! now i-component velocity 270 CALL iom_get( numror, jpdom_local, 'vn' , vn ) ! now j-component velocity 271 CALL iom_get( numror, jpdom_local, 'tn' , tn ) ! now temperature 272 CALL iom_get( numror, jpdom_local, 'sn' , sn ) ! now salinity 273 CALL iom_get( numror, jpdom_local, 'rotn' , rotn ) ! now curl 274 CALL iom_get( numror, jpdom_local, 'hdivn', hdivn ) ! now horizontal divergence 275 276 277 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 278 tb (:,:,:) = tn (:,:,:) ! all before fields set to now field values 279 sb (:,:,:) = sn (:,:,:) 280 ub (:,:,:) = un (:,:,:) 281 vb (:,:,:) = vn (:,:,:) 282 rotb (:,:,:) = rotn (:,:,:) 283 hdivb(:,:,:) = hdivn(:,:,:) 284 ENDIF 285 286 !!sm: TO BE MOVED IN NEW SURFACE MODULE... 287 374 288 # if defined key_ice_lim 375 289 ! Louvain La Neuve Sea Ice Model 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 ) 290 IF( iom_varid( numror, 'nfice' ) > 0 ) then 291 CALL iom_get( numror , 'nfice' , znfice ) ! ice computation frequency 292 CALL iom_get( numror, jpdom_local, 'sst_io' , sst_io ) 293 CALL iom_get( numror, jpdom_local, 'sss_io' , sss_io ) 294 CALL iom_get( numror, jpdom_local, 'u_io' , u_io ) 295 CALL iom_get( numror, jpdom_local, 'v_io' , v_io ) 384 296 #if defined key_coupled 385 CALL iom_get( inum, jpdom_local, 'alb_ice', alb_ice )297 CALL iom_get( numror, jpdom_local, 'alb_ice', alb_ice ) 386 298 #endif 387 ENDIF 388 IF( zinfo(1, 1, 8) /= FLOAT(nfice) .OR. ios == 0 ) THEN 299 IF( znfice /= REAL( nfice, wp ) ) THEN ! if nfice changed between 2 runs 300 zcoef = REAL( nfice-1, wp ) / znfice 301 sst_io(:,:) = zcoef * sst_io(:,:) 302 sss_io(:,:) = zcoef * sss_io(:,:) 303 u_io (:,:) = zcoef * u_io (:,:) 304 v_io (:,:) = zcoef * v_io (:,:) 305 ENDIF 306 ELSE 389 307 IF(lwp) WRITE(numout,*) 390 308 IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization' 391 309 IF(lwp) WRITE(numout,*) 392 sst_io(:,:) = ( nfice-1 )*( tn(:,:,1) + rt0 ) !!bug a explanation is needed here! 393 sss_io(:,:) = ( nfice-1 )* sn(:,:,1) 310 zcoef = REAL( nfice-1, wp ) 311 sst_io(:,:) = zcoef *( tn(:,:,1) + rt0 ) !!bug a explanation is needed here! 312 sss_io(:,:) = zcoef * sn(:,:,1) 313 zcoef = 0.5 * REAL( nfice-1, wp ) 394 314 DO jj = 2, jpj 395 DO ji = 2, jpi396 u_io(ji,jj) = ( nfice-1 ) * 0.5* ( un(ji-1,jj ,1) + un(ji-1,jj-1,1) )397 v_io(ji,jj) = ( nfice-1 ) * 0.5* ( vn(ji ,jj-1,1) + vn(ji-1,jj-1,1) )315 DO ji = fs_2, jpi ! vector opt. 316 u_io(ji,jj) = zcoef * ( un(ji-1,jj ,1) + un(ji-1,jj-1,1) ) 317 v_io(ji,jj) = zcoef * ( vn(ji ,jj-1,1) + vn(ji-1,jj-1,1) ) 398 318 END DO 399 319 END DO … … 405 325 # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 406 326 ! Louvain La Neuve Sea Ice Model 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 327 IF( iom_varid( numror, 'nfbulk' ) > 0 ) THEN 328 CALL iom_get( numror , 'nfbulk', znfbulk ) ! bulk computation frequency 329 CALL iom_get( numror, jpdom_local, 'gsst' , gsst ) 330 IF( znfbulk /= REAL(nfbulk, wp) ) THEN ! if you change nfbulk between 2 runs 331 zcoef = REAL( nfbulk-1, wp ) / znfbulk 332 gsst(:,:) = zcoef * gsst(:,:) 333 ENDIF 334 ELSE 414 335 IF(lwp) WRITE(numout,*) 415 336 IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization' 416 337 IF(lwp) WRITE(numout,*) 417 gsst(:,:) = 0. 418 gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 ) 338 gsst(:,:) = REAL( nfbulk - 1, wp )*( tn(:,:,1) + rt0 ) 419 339 ENDIF 420 340 # endif 421 341 422 CALL iom_close( inum ) 423 424 ! In case of restart with neuler = 0 then put all before fields = to now fields 425 IF ( neuler == 0 ) THEN 426 tb(:,:,:)=tn(:,:,:) 427 sb(:,:,:)=sn(:,:,:) 428 ub(:,:,:)=un(:,:,:) 429 vb(:,:,:)=vn(:,:,:) 430 rotb(:,:,:)=rotn(:,:,:) 431 hdivb(:,:,:)=hdivn(:,:,:) 432 #if defined key_dynspg_rl 433 ! rigid lid 434 bsfb(:,:)=bsfn(:,:) 435 #else 436 ! free surface formulation (eta) 437 sshb(:,:)=sshn(:,:) 342 !!sm: end of TO BE MOVED IN NEW SURFACE MODULE... 343 ! 344 END SUBROUTINE rst_read 345 438 346 #endif 439 ENDIF 440 441 END SUBROUTINE rst_read 442 443 #endif 347 444 348 !!===================================================================== 445 349 END MODULE restart
Note: See TracChangeset
for help on using the changeset viewer.
