- Timestamp:
- 2015-07-10T13:28:53+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r4663 r5581 69 69 END TYPE FLD 70 70 71 TYPE, PUBLIC :: MAP_POINTER !: Array of integer pointers to 1D arrays 72 INTEGER, POINTER :: ptr(:) 71 TYPE, PUBLIC :: MAP_POINTER !: Map from input data file to local domain 72 INTEGER, POINTER, DIMENSION(:) :: ptr ! Array of integer pointers to 1D arrays 73 LOGICAL :: ll_unstruc ! Unstructured (T) or structured (F) boundary data file 73 74 END TYPE MAP_POINTER 74 75 … … 153 154 IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1 154 155 155 it_offset = 0 156 IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 157 ELSE ; it_offset = 0 158 ENDIF 156 159 IF( PRESENT(kt_offset) ) it_offset = kt_offset 157 160 … … 451 454 ENDIF 452 455 ! 453 it_offset = 0 456 IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 457 ELSE ; it_offset = 0 458 ENDIF 454 459 IF( PRESENT(kt_offset) ) it_offset = kt_offset 455 460 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) … … 473 478 ! forcing record : 1 474 479 ! 475 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp ) 480 ztmp = REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 & 481 & + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday ) 476 482 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 477 483 ! swap at the middle of the year 478 IF( llbefore ) THEN ; sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0) 479 ELSE ; sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1) 484 IF( llbefore ) THEN ; sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + & 485 & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1) 486 ELSE ; sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + & 487 & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2) 480 488 ENDIF 481 489 ELSE ! no time interpolation … … 501 509 ! forcing record : nmonth 502 510 ! 503 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp ) 511 ztmp = REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 & 512 & + REAL( it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) 504 513 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 505 514 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) … … 597 606 ! 598 607 IF( ASSOCIATED(map%ptr) ) THEN 599 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map %ptr)600 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map %ptr)608 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 609 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map ) 601 610 ENDIF 602 611 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN … … 668 677 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid (2 dimensional) 669 678 INTEGER , INTENT(in ) :: nrec ! record number to read (ie time slice) 670 INTEGER, DIMENSION(:), INTENT(in ) :: map ! global-to-local mapping indices679 TYPE(MAP_POINTER) , INTENT(in ) :: map ! global-to-local mapping indices 671 680 !! 672 681 INTEGER :: ipi ! length of boundary data on local process … … 689 698 #if defined key_bdy 690 699 ipj = iom_file(num)%dimsz(2,idvar) 691 IF ( ipj == 1) THEN ! we assume that this is a structured open boundaryfile700 IF ( map%ll_unstruc) THEN ! unstructured open boundary data file 692 701 dta_read => dta_global 693 ELSE 702 ELSE ! structured open boundary data file 694 703 dta_read => dta_global2 695 704 ENDIF … … 704 713 END SELECT 705 714 ! 706 IF ( ipj==1) THEN715 IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file 707 716 DO ib = 1, ipi 708 717 DO ik = 1, ipk 709 dta(ib,1,ik) = dta_read(map (ib),1,ik)718 dta(ib,1,ik) = dta_read(map%ptr(ib),1,ik) 710 719 END DO 711 720 END DO 712 ELSE ! we assume that this is a structured open boundaryfile721 ELSE ! structured open boundary data file 713 722 DO ib = 1, ipi 714 jj=1+floor(REAL(map (ib)-1)/REAL(ilendta))715 ji=map (ib)-(jj-1)*ilendta723 jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta)) 724 ji=map%ptr(ib)-(jj-1)*ilendta 716 725 DO ik = 1, ipk 717 726 dta(ib,1,ik) = dta_read(ji,jj,ik) … … 1016 1025 INTEGER :: ipk ! temporary vertical dimension 1017 1026 CHARACTER (len=5) :: aname 1018 INTEGER , DIMENSION( 3):: ddims1027 INTEGER , DIMENSION(:), ALLOCATABLE :: ddims 1019 1028 INTEGER , POINTER, DIMENSION(:,:) :: data_src 1020 1029 REAL(wp), POINTER, DIMENSION(:,:) :: data_tmp … … 1039 1048 1040 1049 !! get dimensions 1050 IF ( SIZE(sd%fnow, 3) > 1 ) THEN 1051 ALLOCATE( ddims(4) ) 1052 ELSE 1053 ALLOCATE( ddims(3) ) 1054 ENDIF 1041 1055 id = iom_varid( inum, sd%clvar, ddims ) 1042 1056 … … 1135 1149 CALL ctl_stop( ' fld_weight : unable to read the file ' ) 1136 1150 ENDIF 1151 1152 DEALLOCATE (ddims ) 1137 1153 1138 1154 CALL wrk_dealloc( jpi,jpj, data_src ) ! integer
Note: See TracChangeset
for help on using the changeset viewer.