- Timestamp:
- 2018-11-16T15:59:30+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO4_beta_mirror/src/TOP/PISCES/SED/sedrst.F90
r9950 r10321 1 1 MODULE sedrst 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedrst *** … … 11 10 USE sed 12 11 USE sedarr 12 USE trc_oce, ONLY: l_offline ! ocean space and time domain variables 13 USE iom 14 USE daymod 15 USE lib_mpp ! distribued memory computing library 13 16 14 17 … … 18 21 19 22 !! * Accessibility 23 PUBLIC sed_rst_opn ! called by ??? 20 24 PUBLIC sed_rst_read 21 25 PUBLIC sed_rst_wri 22 23 !! * Module variables 24 INTEGER, PUBLIC :: numrsr, numrsw !: logical unit for sed restart (read and write) 25 26 26 PUBLIC sed_rst_cal 27 27 28 !! $Id$ 28 29 CONTAINS 29 30 31 32 SUBROUTINE sed_rst_opn( kt ) 33 !!---------------------------------------------------------------------- 34 !! *** sed_rst_opn *** 35 !! 36 !! ** purpose : output of sed-trc variable in a netcdf file 37 !!---------------------------------------------------------------------- 38 INTEGER, INTENT(in) :: kt ! number of iteration 39 ! 40 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character 41 CHARACTER(LEN=50) :: clname ! trc output restart file name 42 CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file 43 !!---------------------------------------------------------------------- 44 ! 45 IF( l_offline ) THEN 46 IF( kt == nittrc000 ) THEN 47 lrst_sed = .FALSE. 48 IF( ln_rst_list ) THEN 49 nrst_lst = 1 50 nitrst = nstocklist( nrst_lst ) 51 ELSE 52 nitrst = nitend 53 ENDIF 54 ENDIF 55 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 56 ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 57 nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing 58 IF( nitrst > nitend ) nitrst = nitend ! make sure we write a restart at the end of the run 59 ENDIF 60 ELSE 61 IF( kt == nittrc000 ) lrst_sed = .FALSE. 62 ENDIF 63 64 ! to get better performances with NetCDF format: 65 ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 66 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 67 IF( kt == nitrst - 2*nn_dtsed .OR. nstock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN 68 ! beware of the format used to write kt (default is i8.8, that should be large enough) 69 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 70 ELSE ; WRITE(clkt,'(i8.8)') nitrst 71 ENDIF 72 ! create the file 73 IF(lwp) WRITE(numsed,*) 74 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_sedrst_out) 75 clpath = TRIM(cn_sedrst_outdir) 76 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 77 IF(lwp) WRITE(numsed,*) & 78 ' open sed restart.output NetCDF file: ',TRIM(clpath)//clname 79 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpksed ) 80 lrst_sed = .TRUE. 81 ENDIF 82 ! 83 END SUBROUTINE sed_rst_opn 30 84 31 85 SUBROUTINE sed_rst_read … … 40 94 !! ! 06-07 (C. Ethe) original 41 95 !!---------------------------------------------------------------------- 42 !! * Modules used43 USE iom44 96 45 97 !! * local declarations 46 INTEGER :: ji, jk, jn 47 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zdta 48 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: zdta1 49 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zhipor 98 INTEGER :: ji, jj, jk, jn 99 REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: zdta 100 REAL(wp), DIMENSION(jpi,jpj,jpksed,2) :: zdta1 101 REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2 102 REAL(wp), DIMENSION(jpoce,jpksed) :: zhipor 50 103 REAL(wp) :: zkt 51 104 CHARACTER(len = 20) :: cltra 105 CHARACTER(LEN=20) :: name1 52 106 INTEGER :: jlibalt = jprstlib 53 107 LOGICAL :: llok 54 108 !-------------------------------------------------------------------- 55 56 57 WRITE(numsed,*) ' ' 58 WRITE(numsed,*) ' Initilization of Sediment components from restart'59 WRITE(numsed,*) ''60 61 ALLOCATE( zdta(jpi,jpj,jpksed,jptrased), zdta1(jpi,jpj,jpksed,2), zhipor(jpoce,jpksed) ) 62 63 CALL iom_open( 'restart_sed', numrsr, kiolib = jlibalt )64 CALL iom_get( numrsr, 'kt' , zkt ) ! time-step65 109 110 IF( ln_timing ) CALL timing_start('sed_rst_read') 111 112 IF (lwp) WRITE(numsed,*) ' ' 113 IF (lwp) WRITE(numsed,*) ' Initilization of Sediment components from restart' 114 IF (lwp) WRITE(numsed,*) ' ' 115 116 zdta = 1. 117 zdta1 = 1. 118 zdta2 = 0. 119 66 120 DO jn = 1, jptrased 67 cltra = sedtrcd(jn) 68 CALL iom_get( numrsr, jpdom_unknown, cltra, zdta(:,:,:,jn), & 69 & kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) ) 70 ENDDO 71 72 73 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsopal), & 74 & zdta(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) ) 75 76 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsclay), & 77 & zdta(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) ) 78 79 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jspoc), & 80 & zdta(1:jpi,1:jpj,1:jpksed,3), iarroce(1:jpoce) ) 81 82 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jscal), & 83 & zdta(1:jpi,1:jpj,1:jpksed,4), iarroce(1:jpoce) ) 84 85 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwsil), & 86 & zdta(1:jpi,1:jpj,1:jpksed,5), iarroce(1:jpoce) ) 87 88 89 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwoxy), & 90 & zdta(1:jpi,1:jpj,1:jpksed,6), iarroce(1:jpoce) ) 91 92 93 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwdic), & 94 & zdta(1:jpi,1:jpj,1:jpksed,7), iarroce(1:jpoce) ) 95 96 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwno3), & 97 & zdta(1:jpi,1:jpj,1:jpksed,8), iarroce(1:jpoce) ) 98 99 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwpo4), & 100 & zdta(1:jpi,1:jpj,1:jpksed,9), iarroce(1:jpoce) ) 101 102 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwalk), & 103 & zdta(1:jpi,1:jpj,1:jpksed,10), iarroce(1:jpoce) ) 104 105 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwc13), & 106 & zdta(1:jpi,1:jpj,1:jpksed,11), iarroce(1:jpoce) ) 121 cltra = TRIM(sedtrcd(jn)) 122 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 123 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta(:,:,:,jn) ) 124 ELSE 125 zdta(:,:,:,jn) = 0.0 126 ENDIF 127 ENDDO 128 129 DO jn = 1, jpsol 130 CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jn), & 131 & zdta(1:jpi,1:jpj,1:jpksed,jn), iarroce(1:jpoce) ) 132 END DO 133 134 DO jn = 1, jpwat 135 CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jn), & 136 & zdta(1:jpi,1:jpj,1:jpksed,jpsol+jn), iarroce(1:jpoce) ) 137 END DO 107 138 108 139 DO jn = 1, 2 109 cltra = seddia3d(jn) 110 CALL iom_get( numrsr, jpdom_unknown, cltra, zdta1(:,:,:,jn), & 111 & kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) ) 140 cltra = TRIM(seddia3d(jn)) 141 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 142 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta1(:,:,:,jn) ) 143 ELSE 144 zdta1(:,:,:,jn) = 0.0 145 ENDIF 112 146 ENDDO 113 147 … … 122 156 ENDDO 123 157 ENDDO 124 158 125 159 CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), & 126 160 & zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) ) … … 131 165 pwcp (1:jpoce,1,:) = 0. 132 166 133 DEALLOCATE( zdta ) 134 DEALLOCATE( zdta1 ) 135 DEALLOCATE( zhipor ) 167 cltra = "dbioturb" 168 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 169 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 170 ELSE 171 zdta2(:,:,:) = 0.0 172 ENDIF 173 174 CALL pack_arr( jpoce, db(1:jpoce,1:jpksed), & 175 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 176 177 cltra = "irrig" 178 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 179 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 180 ELSE 181 zdta2(:,:,:) = 0.0 182 ENDIF 183 184 CALL pack_arr( jpoce, irrig(1:jpoce,1:jpksed), & 185 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 186 187 cltra = "sedligand" 188 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 189 CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 190 ELSE 191 zdta2(:,:,:) = 0.0 192 ENDIF 193 194 CALL pack_arr( jpoce, sedligand(1:jpoce,1:jpksed), & 195 & zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 196 197 IF( ln_timing ) CALL timing_stop('sed_rst_read') 136 198 137 199 END SUBROUTINE sed_rst_read … … 147 209 !!---------------------------------------------------------------------- 148 210 !!* Modules used 149 USE ioipsl150 !! *Arguments151 211 INTEGER, INTENT(in) :: kt ! number of iteration 152 212 !! * local declarations 153 INTEGER :: ji, jk 154 INTEGER :: ic, jc, jn, itime 155 REAL(wp) :: zdate0 213 INTEGER :: ji, jj, jk, jn 156 214 REAL(wp), DIMENSION(1) :: zinfo 157 CHARACTER(len=50) :: clname,cln 158 CHARACTER(len=20) :: cltra 159 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zdta 215 CHARACTER(len=50) :: clname 216 CHARACTER(len=20) :: cltra, name1 217 REAL(wp), DIMENSION(jpoce,jpksed) :: zdta 218 REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2 160 219 !! ----------------------------------------------------------------------- 161 220 162 ALLOCATE( zdta(jpoce,jpksed) ) 163 164 IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN 165 221 IF( ln_timing ) CALL timing_start('sed_rst_wri') 222 166 223 !! 0. initialisations 167 224 !! ------------------ 168 225 169 170 226 IF(lwp) WRITE(numsed,*) ' ' 227 IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ', & 171 228 'at it= ',kt 172 IF(lwp) WRITE(numsed,*) '~~~~~~~~~' 229 IF(lwp) WRITE(numsed,*) '~~~~~~~~~' 230 231 232 trcsedi(:,:,:,:) = 0.0 233 flxsedi3d(:,:,:,:) = 0.0 234 zdta(:,:) = 1.0 235 zdta2(:,:,:) = 0.0 236 173 237 174 !! 1. WRITE in nutwrs 175 !! ------------------ 176 177 ic = 1 178 DO jc = 1,16 179 IF( cexper(jc:jc) /= ' ') ic = jc 180 END DO 181 WRITE( cln,'("_",i5.5,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday 182 clname = cexper(1:ic)//cln 183 itime = 0 184 CALL ymds2ju( nyear, nmonth, nday, rdt, zdate0 ) 185 zdate0 = zdate0 - adatrj ! set calendar origin to the beginning of the experiment 186 CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, & 187 & clname, itime, zdate0, dtsed*nstock, numrsw, domain_id=nidom ) 188 zinfo(1) = REAL( kt) 189 CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo ) 190 191 192 193 ! Back to 2D geometry 194 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 195 & solcp(1:jpoce,1:jpksed,jsopal ) ) 238 !! 1. WRITE in nutwrs 239 !! ------------------ 240 241 zinfo(1) = REAL( kt) 242 CALL iom_rstput( kt, nitrst, numrsw, 'kt', zinfo ) 243 244 ! Back to 2D geometry 245 DO jn = 1, jpsol 246 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & 247 & solcp(1:jpoce,1:jpksed,jn ) ) 248 END DO 249 250 DO jn = 1, jpwat 251 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol+jn) , iarroce(1:jpoce), & 252 & pwcp(1:jpoce,1:jpksed,jn ) ) 253 END DO 254 ! pH 255 DO jk = 1, jpksed 256 DO ji = 1, jpoce 257 zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) 258 ENDDO 259 ENDDO 260 261 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 262 & zdta(1:jpoce,1:jpksed) ) 196 263 197 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 198 & solcp(1:jpoce,1:jpksed,jsclay ) ) 199 200 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & 201 & solcp(1:jpoce,1:jpksed,jspoc ) ) 202 203 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & 204 & solcp(1:jpoce,1:jpksed,jscal ) ) 205 206 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & 207 & pwcp(1:jpoce,1:jpksed,jwsil ) ) 208 209 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6) , iarroce(1:jpoce), & 210 & pwcp(1:jpoce,1:jpksed,jwoxy ) ) 211 212 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7) , iarroce(1:jpoce), & 213 & pwcp(1:jpoce,1:jpksed,jwdic ) ) 214 215 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8) , iarroce(1:jpoce), & 216 & pwcp(1:jpoce,1:jpksed,jwno3 ) ) 217 218 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9) , iarroce(1:jpoce), & 219 & pwcp(1:jpoce,1:jpksed,jwpo4 ) ) 220 221 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10) , iarroce(1:jpoce), & 222 & pwcp(1:jpoce,1:jpksed,jwalk ) ) 223 224 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11) , iarroce(1:jpoce), & 225 & pwcp(1:jpoce,1:jpksed,jwc13 ) ) 226 227 ! porosity 228 zdta(:,:) = 0. 229 DO jk = 1, jpksed 230 DO ji = 1, jpoce 231 zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) ) 232 ENDDO 233 ENDDO 234 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 235 & zdta(1:jpoce,1:jpksed) ) 236 237 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 238 & co3por(1:jpoce,1:jpksed) ) 239 240 ! prognostic variables 241 ! -------------------- 242 243 244 DO jn = 1, jptrased 245 cltra = sedtrcd(jn) 246 CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) ) 247 ENDDO 248 249 DO jn = 1, 2 250 cltra = seddia3d(jn) 251 CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, flxsedi3d(:,:,:,jn) ) 252 ENDDO 253 254 255 CALL restclo( numrsw ) 256 257 ENDIF 258 259 DEALLOCATE( zdta ) 264 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 265 & co3por(1:jpoce,1:jpksed) ) 266 267 ! prognostic variables 268 ! -------------------- 269 270 DO jn = 1, jptrased 271 cltra = TRIM(sedtrcd(jn)) 272 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), trcsedi(:,:,:,jn) ) 273 ENDDO 274 275 DO jn = 1, 2 276 cltra = TRIM(seddia3d(jn)) 277 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), flxsedi3d(:,:,:,jn) ) 278 ENDDO 279 280 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 281 & db(1:jpoce,1:jpksed) ) 282 283 cltra = "dbioturb" 284 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 285 286 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 287 & irrig(1:jpoce,1:jpksed) ) 288 289 cltra = "irrig" 290 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 291 292 CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), & 293 & sedligand(1:jpoce,1:jpksed) ) 294 295 cltra = "sedligand" 296 CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) ) 297 298 IF( kt == nitrst ) THEN 299 CALL iom_close( numrsw ) ! close the restart file (only at last time step) 300 IF( l_offline .AND. ln_rst_list ) THEN 301 nrst_lst = nrst_lst + 1 302 nitrst = nstocklist( nrst_lst ) 303 ENDIF 304 ENDIF 305 306 IF( ln_timing ) CALL timing_stop('sed_rst_wri') 260 307 261 308 END SUBROUTINE sed_rst_wri 262 #else 263 !!====================================================================== 264 !! MODULE sedrst : Dummy module 265 !!====================================================================== 266 !! $Id$ 267 CONTAINS 268 SUBROUTINE sed_rst_read ! Empty routines 269 END SUBROUTINE sed_rst_read 270 SUBROUTINE sed_rst_wri( kt ) 271 INTEGER, INTENT ( in ) :: kt 272 WRITE(*,*) 'sed_rst_wri: You should not have seen this print! error?', kt 273 END SUBROUTINE sed_rst_wri 274 #endif 309 310 311 SUBROUTINE sed_rst_cal( kt, cdrw ) 312 !!--------------------------------------------------------------------- 313 !! *** ROUTINE sed_rst_cal *** 314 !! 315 !! ** Purpose : Read or write calendar in restart file: 316 !! 317 !! WRITE(READ) mode: 318 !! kt : number of time step since the begining of the experiment at the 319 !! end of the current(previous) run 320 !! adatrj(0) : number of elapsed days since the begining of the experiment at the 321 !! end of the current(previous) run (REAL -> keep fractions of day) 322 !! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer) 323 !! 324 !! According to namelist parameter nrstdt, 325 !! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary). 326 !! nn_rsttr = 1 we verify that nittrc000 is equal to the last 327 !! time step of previous run + 1. 328 !! In both those options, the exact duration of the experiment 329 !! since the beginning (cumulated duration of all previous restart runs) 330 !! is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 331 !! This is valid is the time step has remained constant. 332 !! 333 !! nn_rsttr = 2 the duration of the experiment in days (adatrj) 334 !! has been stored in the restart file. 335 !!---------------------------------------------------------------------- 336 INTEGER , INTENT(in) :: kt ! ocean time-step 337 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 338 ! 339 INTEGER :: jlibalt = jprstlib 340 LOGICAL :: llok 341 REAL(wp) :: zkt, zrdttrc1 342 REAL(wp) :: zndastp 343 344 ! Time domain : restart 345 ! --------------------- 346 347 IF( TRIM(cdrw) == 'READ' ) THEN 348 349 IF(lwp) WRITE(numsed,*) 350 IF(lwp) WRITE(numsed,*) 'sed_rst_cal : read the SED restart file for calendar' 351 IF(lwp) WRITE(numsed,*) '~~~~~~~~~~~~' 352 353 IF( ln_rst_sed ) THEN 354 CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr, kiolib = jlibalt ) 355 CALL iom_get ( numrsr, 'kt', zkt ) ! last time-step of previous run 356 357 IF(lwp) THEN 358 WRITE(numsed,*) ' *** Info read in restart : ' 359 WRITE(numsed,*) ' previous time-step : ', NINT( zkt ) 360 WRITE(numsed,*) ' *** restart option' 361 SELECT CASE ( nn_rstsed ) 362 CASE ( 0 ) ; WRITE(numsed,*) ' nn_rstsed = 0 : no control of nittrc000' 363 CASE ( 1 ) ; WRITE(numsed,*) ' nn_rstsed = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 364 CASE ( 2 ) ; WRITE(numsed,*) ' nn_rstsed = 2 : calendar parameters read in restart' 365 END SELECT 366 WRITE(numsed,*) 367 ENDIF 368 ! Control of date 369 IF( nittrc000 - NINT( zkt ) /= nn_dtsed .AND. nn_rstsed /= 0 ) & 370 & CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', & 371 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 372 ENDIF 373 ! 374 IF( l_offline ) THEN 375 ! ! set the date in offline mode 376 IF( ln_rst_sed .AND. nn_rstsed == 2 ) THEN 377 CALL iom_get( numrsr, 'ndastp', zndastp ) 378 ndastp = NINT( zndastp ) 379 CALL iom_get( numrsr, 'adatrj', adatrj ) 380 ELSE 381 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 382 adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday 383 ! note this is wrong if time step has changed during run 384 ENDIF 385 ! 386 IF(lwp) THEN 387 WRITE(numsed,*) ' *** Info used values : ' 388 WRITE(numsed,*) ' date ndastp : ', ndastp 389 WRITE(numsed,*) ' number of elapsed days since the begining of run : ', adatrj 390 WRITE(numsed,*) 391 ENDIF 392 ! 393 CALL day_init ! compute calendar 394 ! 395 ENDIF 396 ! 397 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 398 ! 399 IF( kt == nitrst ) THEN 400 IF(lwp) WRITE(numsed,*) 401 IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp 402 IF(lwp) WRITE(numsed,*) '~~~~~~~' 403 ENDIF 404 CALL iom_rstput( kt, nitrst, numrsw, 'kt' , REAL( kt , wp) ) ! time-step 405 CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp) ) ! date 406 CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj ) ! number of elapsed days since 407 ! ! the begining of the run [s] 408 ENDIF 409 410 END SUBROUTINE sed_rst_cal 275 411 276 412 END MODULE sedrst
Note: See TracChangeset
for help on using the changeset viewer.
