Changeset 611 for trunk/NEMO/OPA_SRC
- Timestamp:
- 2007-02-21T10:24:26+01:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/IOM/iom.F90
r556 r611 682 682 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 683 683 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 684 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, pvar )684 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar ) 685 685 CASE DEFAULT 686 686 CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) … … 702 702 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 703 703 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 704 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r1d = pvar )704 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar ) 705 705 CASE DEFAULT 706 706 CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) … … 722 722 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 723 723 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 724 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r2d = pvar )724 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar ) 725 725 CASE DEFAULT 726 726 CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) … … 742 742 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 743 743 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 744 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r3d = pvar )744 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar ) 745 745 CASE DEFAULT 746 746 CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' ) -
trunk/NEMO/OPA_SRC/IOM/iom_rstdimg.F90
r588 r611 68 68 INTEGER :: in0d, in1d, in2d, in3d ! number of 0/1/2/3D variables 69 69 INTEGER :: ipni, ipnj, ipnij, iarea ! domain decomposition 70 INTEGER :: iiglo, ijglo ! domain global size 70 71 INTEGER :: jl ! loop variable 71 72 CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) :: clna0d, clna1d, clna2d, clna3d ! name of 0/1/2/3D variables … … 118 119 ! ============= 119 120 IF( ldok ) THEN ! old file 120 READ( idrst, REC = 1 , IOSTAT = ios, ERR = 987 ) & 121 & irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd 122 READ( idrst, REC = irhd, IOSTAT = ios, ERR = 987 ) & 121 READ( idrst, REC = 1 , IOSTAT = ios, ERR = 987 ) & 122 & irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd, & 123 & ipni, ipnj, ipnij, iarea, iiglo, ijglo 124 READ( idrst, REC = irhd, IOSTAT = ios, ERR = 987 ) & 123 125 & clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d), & 124 & clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d), & 125 & ipni, ipnj, ipnij, iarea 126 & clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d) 126 127 clinfo = TRIM(clinfo)//' file '//TRIM(cdname) 127 IF( inx /= kdompar(1,1) ) CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in i direction' ) 128 IF( iny /= kdompar(2,1) ) CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in j direction' ) 128 IF( iiglo /= jpiglo ) CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in i direction' ) 129 IF( ijglo /= jpjglo ) CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in j direction' ) 130 IF( inx /= kdompar(1,1) ) CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in i direction' ) 131 IF( iny /= kdompar(2,1) ) CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in j direction' ) 129 132 IF( inz /= jpk ) CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in k direction' ) 130 133 IF( ipni /= jpni ) CALL ctl_stop( TRIM(clinfo), 'Processor splitting changed along I' ) … … 266 269 IF( in3d == 0 ) THEN ; in3d = 1 ; clna3d(1) = 'no3d' ; zval3d(1) = -1. ; ENDIF 267 270 ! update the file header before closing it 268 WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) &271 WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) & 269 272 & irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd, & 270 & jpni, jpnj, jpnij, narea, jpiglo, jpjglo, &273 & jpni, jpnj, jpnij, narea, jpiglo, jpjglo, & 271 274 & nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt 272 275 IF( (ivnum * (jpvnl + wp)) > irecl8 ) THEN … … 274 277 & 'Last record size is too big... You could reduce the value of jpvnl' ) 275 278 ELSE 276 WRITE( idrst, REC = irhd, IOSTAT = ios, ERR = 987 ) &279 WRITE( idrst, REC = irhd, IOSTAT = ios, ERR = 987 ) & 277 280 & clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d), & 278 281 & clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d) … … 309 312 310 313 311 SUBROUTINE iom_rstdimg_rp0d( kiomid, cdvar, pv_r0d )314 SUBROUTINE iom_rstdimg_rp0d( kiomid, cdvar, kvid, pv_r0d ) 312 315 !!-------------------------------------------------------------------- 313 316 !! *** SUBROUTINE iom_rstdimg_rstput *** … … 317 320 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 318 321 CHARACTER(len=*) , INTENT(in) :: cdvar ! time axis name 322 INTEGER , INTENT(in) :: kvid ! variable id 319 323 REAL(wp) , INTENT(in) :: pv_r0d ! written 0d field 320 324 ! … … 324 328 ! 325 329 clinfo = ' iom_rstdimg_rp0d ~~~ ' 326 idvar = iom_file(kiomid)%nvars + 1 330 IF( kvid <= 0 ) THEN ! new variable 331 idvar = iom_file(kiomid)%nvars + 1 332 ELSE ! the variable already exists in the file 333 idvar = kvid 334 ENDIF 327 335 IF( idvar <= jpmax_vars ) THEN 328 336 iom_file(kiomid)%nvars = idvar … … 422 430 423 431 424 SUBROUTINE iom_rstdimg_rp123d( kiomid, cdvar, pv_r1d, pv_r2d, pv_r3d )432 SUBROUTINE iom_rstdimg_rp123d( kiomid, cdvar, kvid, pv_r1d, pv_r2d, pv_r3d ) 425 433 !!-------------------------------------------------------------------- 426 434 !! *** SUBROUTINE iom_rstdimg_rstput *** … … 430 438 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 431 439 CHARACTER(len=*) , INTENT(in) :: cdvar ! time axis name 440 INTEGER , INTENT(in) :: kvid ! variable id 432 441 REAL(wp), DIMENSION( jpk), INTENT(in), OPTIONAL :: pv_r1d ! written 1d field 433 442 REAL(wp), DIMENSION(jpi,jpj ), INTENT(in), OPTIONAL :: pv_r2d ! written 2d field … … 450 459 irec = iom_file(kiomid)%irec ! get back the record number of the variable 451 460 idrst = iom_file(kiomid)%nfid ! get back the logical unit of the restart file 452 idvar = iom_file(kiomid)%nvars + 1 461 IF( kvid <= 0 ) THEN ! new variable 462 idvar = iom_file(kiomid)%nvars + 1 463 ELSE ! the variable already exists in the file 464 idvar = kvid 465 ENDIF 453 466 IF( idvar > jpmax_vars ) CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' ) 454 467 IF( .NOT. PRESENT(pv_r1d) ) THEN -
trunk/NEMO/OPA_SRC/restart.F90
r593 r611 82 82 ENDIF 83 83 ! create the file 84 IF(lwp) WRITE(numout,*)85 84 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart" 86 IF(lwp) WRITE(numout,*) ' open ocean restart.output NetCDF file: '//clname 85 IF(lwp) THEN 86 WRITE(numout,*) 87 WRITE(numout,*) ' open ocean restart.output NetCDF file: '//clname 88 IF( kt == nitrst-1 ) THEN 89 WRITE(numout,*) ' kt = nitrst - 1 = ', kt,' date= ', ndastp 90 ELSE 91 WRITE(numout,*) ' kt = ', kt,' date= ', ndastp 92 ENDIF 93 ENDIF 94 87 95 CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 88 96 lrst_oce = .TRUE. … … 103 111 INTEGER, INTENT(in) :: kt ! ocean time-step 104 112 !!---------------------------------------------------------------------- 105 106 IF(lwp) THEN107 WRITE(numout,*)108 WRITE(numout,*) 'rst_write : write ocean NetCDF restart file kt =', kt,' date= ', ndastp109 WRITE(numout,*) '~~~~~~~~~'110 ENDIF111 113 112 114 ! calendar control
Note: See TracChangeset
for help on using the changeset viewer.