- Timestamp:
- 2011-07-11T12:53:56+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r2777 r2797 56 56 LOGICAL :: rotn ! flag to indicate whether field has been rotated 57 57 END TYPE FLD 58 59 TYPE, PUBLIC :: MAP_POINTER !: Array of integer pointers to 1D arrays 60 INTEGER, POINTER :: ptr(:) 61 END TYPE MAP_POINTER 58 62 59 63 !$AGRIF_DO_NOT_TREAT … … 98 102 CONTAINS 99 103 100 SUBROUTINE fld_read( kt, kn_fsbc, sd )104 SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, timeshift ) 101 105 !!--------------------------------------------------------------------- 102 106 !! *** ROUTINE fld_read *** … … 113 117 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 114 118 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 119 TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping index 120 INTEGER , INTENT(in ), OPTIONAL :: jit ! subcycle timestep for timesplitting option 121 INTEGER , INTENT(in ), OPTIONAL :: timeshift ! provide fields at time other than "now" 115 122 !! 116 123 INTEGER :: imf ! size of the structure sd … … 127 134 !!--------------------------------------------------------------------- 128 135 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 129 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) ! middle of sbc time step 136 IF( present(timeshift) ) THEN 137 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + timeshift * rdttra(1) ! middle of sbc time step 138 ELSE 139 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) ! middle of sbc time step 140 ENDIF 130 141 imf = SIZE( sd ) 131 142 ! 132 143 IF( kt == nit000 ) THEN ! initialization 133 DO jf = 1, imf 134 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 135 END DO 144 IF( PRESENT(map) ) THEN 145 DO jf = 1, imf 146 CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr ) ! read each before field (put them in after as they will be swapped) 147 END DO 148 ELSE 149 DO jf = 1, imf 150 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 151 END DO 152 ENDIF 136 153 IF( lwp ) CALL wgt_print() ! control print 137 154 CALL fld_rot( kt, sd ) ! rotate vector fiels if needed … … 212 229 213 230 ! read after data 214 CALL fld_get( sd(jf) ) 231 IF( PRESENT(map) ) THEN 232 CALL fld_get( sd(jf), map(jf)%ptr ) 233 ELSE 234 CALL fld_get( sd(jf) ) 235 ENDIF 215 236 216 237 ENDIF … … 230 251 ! temporal interpolation weights 231 252 ztinta = REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 253 IF( PRESENT(map) ) THEN 254 IF(lwp) WRITE(numout,*) '============================================' 255 IF(lwp) WRITE(numout,*) 'Output from fld_read(map) on timestep ',kt 256 IF(lwp) WRITE(numout,*) '============================================' 257 IF(lwp) WRITE(numout,*) 'sd(jf)%nrec_b(2), sd(jf)%nrec_a(2), isecsbc, ztinta, ztintb : ',sd(jf)%nrec_b(2),sd(jf)%nrec_a(2),isecsbc,ztinta,ztintb 258 ENDIF 232 259 ztintb = 1. - ztinta 233 260 !CDIR COLLAPSE … … 253 280 254 281 255 SUBROUTINE fld_init( kn_fsbc, sdjf )282 SUBROUTINE fld_init( kn_fsbc, sdjf, map ) 256 283 !!--------------------------------------------------------------------- 257 284 !! *** ROUTINE fld_init *** … … 262 289 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 263 290 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 291 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 264 292 !! 265 293 LOGICAL :: llprevyr ! are we reading previous year file? … … 364 392 365 393 ! read before data 366 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 394 IF( PRESENT(map) ) THEN 395 CALL fld_get( sdjf, map ) ! read before values in after arrays(as we will swap it later) 396 ELSE 397 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 398 ENDIF 367 399 368 400 clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" … … 546 578 547 579 548 SUBROUTINE fld_get( sdjf )549 !!--------------------------------------------------------------------- 550 !! *** ROUTINE fld_ clopn***580 SUBROUTINE fld_get( sdjf, map ) 581 !!--------------------------------------------------------------------- 582 !! *** ROUTINE fld_get *** 551 583 !! 552 584 !! ** Purpose : read the data 553 585 !!---------------------------------------------------------------------- 554 586 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 587 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 555 588 !! 556 589 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) … … 559 592 560 593 ipk = SIZE( sdjf%fnow, 3 ) 561 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 594 595 IF( PRESENT(map) ) THEN 596 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 597 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map ) 598 ENDIF 599 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 562 600 CALL wgt_list( sdjf, iw ) 563 601 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) … … 581 619 END SUBROUTINE fld_get 582 620 621 SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 622 !!--------------------------------------------------------------------- 623 !! *** ROUTINE fld_get *** 624 !! 625 !! ** Purpose : read global data from file and map onto local data 626 !! using a general mapping (for open boundaries) 627 !!---------------------------------------------------------------------- 628 USE obc_oce, ONLY: dta_global ! workspace to read in global data arrays 629 630 INTEGER , INTENT(in ) :: num ! stream number 631 CHARACTER(LEN=*) , INTENT(in ) :: clvar ! variable name 632 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid 633 INTEGER , INTENT(in ) :: nrec ! record number to read (ie time slice) 634 INTEGER, DIMENSION(:) , INTENT(in ) :: map ! global-to-local mapping indices 635 !! 636 INTEGER :: ipi ! length of boundary data on local process 637 INTEGER :: ipj ! length of dummy dimension ( = 1 ) 638 INTEGER :: ipk ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 639 INTEGER :: ilendta ! length of data in file 640 INTEGER :: idvar ! variable ID 641 INTEGER :: ib, ik ! loop counters 642 INTEGER :: ierr 643 !! 644 CHARACTER(len=80) :: zfile 645 !!--------------------------------------------------------------------- 646 647 ipi = SIZE( dta, 1 ) 648 ipj = 1 649 ipk = SIZE( dta, 3 ) 650 651 idvar = iom_varid( num, clvar ) 652 ilendta = iom_file(num)%dimsz(1,idvar) 653 IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 654 655 CALL iom_get ( num, jpdom_unknown, clvar, dta_global(1:ilendta,1:ipj,1:ipk), nrec ) 656 ! 657 DO ib = 1, ipi 658 DO ik = 1, ipk 659 dta(ib,1,ik) = dta_global(map(ib),1,ik) 660 END DO 661 END DO 662 663 END SUBROUTINE fld_map 583 664 584 665 SUBROUTINE fld_rot( kt, sd ) 585 666 !!--------------------------------------------------------------------- 586 !! *** ROUTINE fld_ clopn***667 !! *** ROUTINE fld_rot *** 587 668 !! 588 669 !! ** Purpose : Vector fields may need to be rotated onto the local grid direction … … 672 753 ! 673 754 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 674 755 ! 675 756 END SUBROUTINE fld_clopn 676 757
Note: See TracChangeset
for help on using the changeset viewer.
