New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2077 for branches/devmercator2010/NEMO/OPA_SRC/SBC/fldread.F90 – NEMO

Ignore:
Timestamp:
2010-09-09T10:43:51+02:00 (14 years ago)
Author:
cbricaud
Message:

commit change from DEV_r1784_3DF

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/fldread.F90

    r2076 r2077  
    4848      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    4949      INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    50       REAL(wp) , ALLOCATABLE, DIMENSION(:,:)   ::   fnow         ! input fields interpolated to now time step 
    51       REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   fdta         ! 2 consecutive record of input fields 
     50      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:)   ::   fnow       ! input fields interpolated to now time step 
     51      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields 
    5252      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key 
    5353                                                        ! into the WGTLIST structure 
     
    7878      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers 
    7979      REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid 
    80       REAL(wp), DIMENSION(:,:), POINTER       ::   fly_dta      ! array of values on input grid 
    81       REAL(wp), DIMENSION(:,:), POINTER       ::   col2         ! temporary array for reading in columns 
     80      REAL(wp), DIMENSION(:,:,:), POINTER     ::   fly_dta      ! array of values on input grid 
     81      REAL(wp), DIMENSION(:,:,:), POINTER     ::   col2         ! temporary array for reading in columns 
    8282   END TYPE WGT 
    8383 
     
    120120 
    121121      INTEGER  ::   jf         ! dummy indices 
     122      INTEGER  ::   jk         ! dummy indices 
     123      INTEGER  ::   ipk        ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    122124      INTEGER  ::   kw         ! index into wgts array 
    123125      INTEGER  ::   ireclast   ! last record to be read in the current year file 
     
    143145            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field 
    144146!CDIR COLLAPSE 
    145                sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) 
    146                sd(jf)%rotn(1)     = sd(jf)%rotn(2) 
     147               sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
     148               sd(jf)%rotn(1)       = sd(jf)%rotn(2) 
    147149            ENDIF 
    148150 
     
    157159 
    158160               ! last record to be read in the current file 
    159                IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12 
     161               IF( sd(jf)%nfreqh == -1 ) THEN 
     162                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 1 
     163                  ELSE                                         ;   ireclast = 12 
     164                  ENDIF 
    160165               ELSE                              
    161166                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
     
    204209            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 
    205210               CALL wgt_list( sd(jf), kw ) 
    206                CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     211               ipk =  SIZE(sd(jf)%fdta,3) 
     212               CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 
    207213            ELSE 
    208                CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     214               SELECT CASE( SIZE(sd(jf)%fdta,3) ) 
     215               CASE(1) 
     216                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 
     217               CASE(jpk) 
     218                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 
     219               END SELECT 
    209220            ENDIF 
    210221            sd(jf)%rotn(2) = .FALSE. 
     
    245256                         utmp(:,:) = 0.0 
    246257                         vtmp(:,:) = 0.0 
    247                          CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) ) 
    248                          CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) ) 
    249                          sd(jf)%fdta(:,:,nf) = utmp(:,:) 
    250                          sd(kf)%fdta(:,:,nf) = vtmp(:,:) 
     258                         ! 
     259                         ipk = SIZE( sd(kf)%fdta(:,:,:,nf) ,3 ) 
     260                         DO jk = 1,ipk 
     261                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 
     262                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 
     263                            sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 
     264                            sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 
     265                         END DO 
     266                         ! 
    251267                         sd(jf)%rotn(nf) = .TRUE. 
    252268                         sd(kf)%rotn(nf) = .TRUE. 
     
    280296               ztintb =  1. - ztinta 
    281297!CDIR COLLAPSE 
    282                sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) 
     298               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
    283299            ELSE 
    284300               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
     
    288304               ENDIF 
    289305!CDIR COLLAPSE 
    290                sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field 
     306               sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2)   ! piecewise constant field 
    291307  
    292308            ENDIF 
     
    320336      INTEGER :: inrec          ! number of record existing for this variable 
    321337      INTEGER :: kwgt 
     338      INTEGER :: jk             !vertical loop variable 
     339      INTEGER :: ipk            !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    322340      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    323341      !!--------------------------------------------------------------------- 
     
    339357               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    340358                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record 
    341                   llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
     359                  llprevmth = .TRUE.                                                       ! use previous month file? 
    342360                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    343361               ELSE                                  ! yearly file 
     
    366384            &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               & 
    367385            &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 
    368           
     386 
    369387         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    370388         IF( llprev .AND. sdjf%num == 0 ) THEN 
     
    384402 
    385403         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 
     404          
    386405         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    387406            CALL wgt_list( sdjf, kwgt ) 
    388             CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     407            ipk = SIZE(sdjf%fdta,3) 
     408            CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    389409         ELSE 
    390             CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     410            SELECT CASE ( SIZE(sdjf%fdta,3) ) 
     411            CASE(1) 
     412                CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 
     413            CASE(jpk) 
     414                CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 
     415            END SELECT 
    391416         ENDIF 
    392417         sdjf%rotn(2) = .FALSE. 
     
    399424      ENDIF 
    400425 
     426 
    401427      IF( sdjf%num == 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
    402428 
    403429      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read  
    404        
     430      
    405431   END SUBROUTINE fld_init 
    406432 
     
    436462            !       forcing record :  nmonth  
    437463            !                             
    438             ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     464            ztmp  = 0.e0 
     465            IF(  REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) .GT. 0.5 ) ztmp  = 1.0 
    439466         ELSE 
    440467            ztmp  = 0.e0 
     
    446473         ENDIF 
    447474 
    448          sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
    449          irec = irec - 1                                                ! move back to previous record 
    450          sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
     475         IF( sdjf%cltype == 'monthly' ) THEN 
     476 
     477            sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /) 
     478            sdjf%nrec_a(:) = (/ 1, nmonth_half(irec     ) + nsec1jan000 /) 
     479 
     480            IF( ztmp  == 1. ) THEN 
     481              sdjf%nrec_b(1) = 1 
     482              sdjf%nrec_a(1) = 2 
     483            ENDIF 
     484 
     485         ELSE 
     486 
     487            sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
     488            irec = irec - 1                                                ! move back to previous record 
     489            sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
     490 
     491         ENDIF 
    451492         ! 
    452493      ELSE                              ! higher frequency mean (in hours) 
     
    534575         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    535576         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
     577      ELSE 
     578         ! build the new filename if climatological data 
     579         IF( sdjf%cltype == 'monthly' )   WRITE(sdjf%clname, '(a,"_m" ,i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
    536580      ENDIF 
    537581      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
     
    564608         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint 
    565609         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim 
    566          IF( sdf(jf)%nfreqh == -1. ) THEN   ;   sdf(jf)%cltype = 'yearly' 
    567          ELSE                               ;   sdf(jf)%cltype = sdf_n(jf)%cltype 
    568          ENDIF 
     610         sdf(jf)%cltype     = sdf_n(jf)%cltype 
    569611         sdf(jf)%wgtname = " " 
    570612         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
     
    684726      INTEGER                                 ::   inum          ! temporary logical unit 
    685727      INTEGER                                 ::   id            ! temporary variable id 
     728      INTEGER                                 ::   ipk           ! temporary vertical dimension 
    686729      CHARACTER (len=5)                       ::   aname 
    687730      INTEGER , DIMENSION(3)                  ::   ddims 
     
    848891         ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration.  
    849892         ! a more robust solution will be given in next release 
    850          ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) ) 
    851          IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) ) 
     893         ipk =  SIZE(sd%fdta,3) 
     894         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 
     895         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) 
    852896 
    853897         nxt_wgt = nxt_wgt + 1 
     
    859903   END SUBROUTINE fld_weight 
    860904 
    861    SUBROUTINE fld_interp(num, clvar, kw, dta, nrec) 
     905   SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec) 
    862906      !!--------------------------------------------------------------------- 
    863907      !!                    ***  ROUTINE fld_interp  *** 
     
    868912      !! ** Method  :    
    869913      !!---------------------------------------------------------------------- 
    870       INTEGER,          INTENT(in)                        ::   num                 ! stream number 
    871       CHARACTER(LEN=*), INTENT(in)                        ::   clvar               ! variable name 
    872       INTEGER,          INTENT(in)                        ::   kw                  ! weights number 
    873       REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj) ::   dta                 ! output field on model grid 
    874       INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice) 
     914      INTEGER,          INTENT(in)                           ::   num                 ! stream number 
     915      CHARACTER(LEN=*), INTENT(in)                           ::   clvar               ! variable name 
     916      INTEGER,          INTENT(in)                           ::   kw                  ! weights number 
     917      INTEGER,          INTENT(in)                           ::   kk                  ! vertical dimension of kk 
     918      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta                 ! output field on model grid 
     919      INTEGER,          INTENT(in)                           ::   nrec                ! record number to read (ie time slice) 
    875920      !!  
    876       INTEGER, DIMENSION(2)                               ::   rec1,recn           ! temporary arrays for start and length 
    877       INTEGER                                             ::  jk, jn, jm           ! loop counters 
    878       INTEGER                                             ::  ni, nj               ! lengths 
    879       INTEGER                                             ::  jpimin,jpiwid        ! temporary indices 
    880       INTEGER                                             ::  jpjmin,jpjwid        ! temporary indices 
    881       INTEGER                                             ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices 
     921      INTEGER, DIMENSION(3)                                  ::   rec1,recn           ! temporary arrays for start and length 
     922      INTEGER                                                ::  jk, jn, jm           ! loop counters 
     923      INTEGER                                                ::  ni, nj               ! lengths 
     924      INTEGER                                                ::  jpimin,jpiwid        ! temporary indices 
     925      INTEGER                                                ::  jpjmin,jpjwid        ! temporary indices 
     926      INTEGER                                                ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices 
    882927      !!---------------------------------------------------------------------- 
    883928      ! 
     
    897942      rec1(1) = MAX( jpimin-1, 1 ) 
    898943      rec1(2) = MAX( jpjmin-1, 1 ) 
     944      rec1(3) = 1 
    899945      recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 ) 
    900946      recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 
     947      recn(3) = kk 
    901948 
    902949      !! where we need to read it to 
     
    906953      jpj2 = jpj1 + recn(2) - 1 
    907954 
    908       ref_wgts(kw)%fly_dta(:,:) = 0.0 
    909       CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn) 
     955      ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
     956      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
     957      CASE(1) 
     958           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
     959      CASE(jpk)   
     960           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
     961      END SELECT  
    910962 
    911963      !! first four weights common to both bilinear and bicubic 
    912964      !! note that we have to offset by 1 into fly_dta array because of halo 
    913       dta(:,:) = 0.0 
     965      dta(:,:,:) = 0.0 
    914966      DO jk = 1,4 
    915         DO jn = 1, jpj 
    916           DO jm = 1,jpi 
     967        DO jn = 1, nlcj 
     968          DO jm = 1,nlci 
    917969            ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    918970            nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    919             dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1) 
     971            dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,jk) 
    920972          END DO 
    921973        END DO 
     
    926978        !! fix up halo points that we couldnt read from file 
    927979        IF( jpi1 == 2 ) THEN 
    928            ref_wgts(kw)%fly_dta(jpi1-1,:) = ref_wgts(kw)%fly_dta(jpi1,:) 
     980           ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 
    929981        ENDIF 
    930982        IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    931            ref_wgts(kw)%fly_dta(jpi2+1,:) = ref_wgts(kw)%fly_dta(jpi2,:) 
     983           ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 
    932984        ENDIF 
    933985        IF( jpj1 == 2 ) THEN 
    934            ref_wgts(kw)%fly_dta(:,jpj1-1) = ref_wgts(kw)%fly_dta(:,jpj1) 
     986           ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 
    935987        ENDIF 
    936988        IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 
    937            ref_wgts(kw)%fly_dta(:,jpj2+1) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1) 
     989           ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 
    938990        ENDIF 
    939991 
     
    9481000           IF( jpi1 == 2 ) THEN 
    9491001              rec1(1) = ref_wgts(kw)%ddims(1) - 1 
    950               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
    951               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2) 
     1002              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 
     1003              CASE(1) 
     1004                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1005              CASE(jpk)          
     1006                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 
     1007              END SELECT       
     1008              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2,:) 
    9521009           ENDIF 
    9531010           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    9541011              rec1(1) = 1 
    955               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
    956               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2) 
     1012              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 
     1013              CASE(1) 
     1014                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1015              CASE(jpk) 
     1016                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 
     1017              END SELECT 
     1018              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2,:) 
    9571019           ENDIF 
    9581020        ENDIF 
     
    9601022        ! gradient in the i direction 
    9611023        DO jk = 1,4 
    962           DO jn = 1, jpj 
    963             DO jm = 1,jpi 
     1024          DO jn = 1, nlcj 
     1025            DO jm = 1,nlci 
    9641026              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9651027              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    966               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
    967                                (ref_wgts(kw)%fly_dta(ni+2,nj+1) - ref_wgts(kw)%fly_dta(ni,nj+1)) 
     1028              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
     1029                               (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:)) 
    9681030            END DO 
    9691031          END DO 
     
    9721034        ! gradient in the j direction 
    9731035        DO jk = 1,4 
    974           DO jn = 1, jpj 
    975             DO jm = 1,jpi 
     1036          DO jn = 1, nlcj 
     1037            DO jm = 1,nlci 
    9761038              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9771039              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    978               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
    979                                (ref_wgts(kw)%fly_dta(ni+1,nj+2) - ref_wgts(kw)%fly_dta(ni+1,nj)) 
     1040              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
     1041                               (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:)) 
    9801042            END DO 
    9811043          END DO 
     
    9881050              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9891051              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    990               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
    991                                (ref_wgts(kw)%fly_dta(ni+2,nj+2) - ref_wgts(kw)%fly_dta(ni  ,nj+2)) -   & 
    992                                (ref_wgts(kw)%fly_dta(ni+2,nj  ) - ref_wgts(kw)%fly_dta(ni  ,nj  ))) 
     1052              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
     1053                               (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   & 
     1054                               (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:))) 
    9931055            END DO 
    9941056          END DO 
Note: See TracChangeset for help on using the changeset viewer.