- Timestamp:
- 2015-07-20T11:11:11+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_CICE_coupling_GSI7/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5234 r5612 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) ) … … 601 606 ! 602 607 IF( ASSOCIATED(map%ptr) ) THEN 603 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map %ptr)604 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 ) 605 610 ENDIF 606 611 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN … … 672 677 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: dta ! output field on model grid (2 dimensional) 673 678 INTEGER , INTENT(in ) :: nrec ! record number to read (ie time slice) 674 INTEGER, DIMENSION(:), INTENT(in ) :: map ! global-to-local mapping indices679 TYPE(MAP_POINTER) , INTENT(in ) :: map ! global-to-local mapping indices 675 680 !! 676 681 INTEGER :: ipi ! length of boundary data on local process … … 693 698 #if defined key_bdy 694 699 ipj = iom_file(num)%dimsz(2,idvar) 695 IF ( ipj == 1) THEN ! we assume that this is a structured open boundaryfile700 IF ( map%ll_unstruc) THEN ! unstructured open boundary data file 696 701 dta_read => dta_global 697 ELSE 702 ELSE ! structured open boundary data file 698 703 dta_read => dta_global2 699 704 ENDIF … … 708 713 END SELECT 709 714 ! 710 IF ( ipj==1) THEN715 IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file 711 716 DO ib = 1, ipi 712 717 DO ik = 1, ipk 713 dta(ib,1,ik) = dta_read(map (ib),1,ik)718 dta(ib,1,ik) = dta_read(map%ptr(ib),1,ik) 714 719 END DO 715 720 END DO 716 ELSE ! we assume that this is a structured open boundaryfile721 ELSE ! structured open boundary data file 717 722 DO ib = 1, ipi 718 jj=1+floor(REAL(map (ib)-1)/REAL(ilendta))719 ji=map (ib)-(jj-1)*ilendta723 jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta)) 724 ji=map%ptr(ib)-(jj-1)*ilendta 720 725 DO ik = 1, ipk 721 726 dta(ib,1,ik) = dta_read(ji,jj,ik) … … 1020 1025 INTEGER :: ipk ! temporary vertical dimension 1021 1026 CHARACTER (len=5) :: aname 1022 INTEGER , DIMENSION( 3):: ddims1027 INTEGER , DIMENSION(:), ALLOCATABLE :: ddims 1023 1028 INTEGER , POINTER, DIMENSION(:,:) :: data_src 1024 1029 REAL(wp), POINTER, DIMENSION(:,:) :: data_tmp … … 1043 1048 1044 1049 !! get dimensions 1050 IF ( SIZE(sd%fnow, 3) > 1 ) THEN 1051 ALLOCATE( ddims(4) ) 1052 ELSE 1053 ALLOCATE( ddims(3) ) 1054 ENDIF 1045 1055 id = iom_varid( inum, sd%clvar, ddims ) 1046 1056 … … 1139 1149 CALL ctl_stop( ' fld_weight : unable to read the file ' ) 1140 1150 ENDIF 1151 1152 DEALLOCATE (ddims ) 1141 1153 1142 1154 CALL wrk_dealloc( jpi,jpj, data_src ) ! integer
Note: See TracChangeset
for help on using the changeset viewer.