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 1951 for branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SBC/fldread.F90 – NEMO

Ignore:
Timestamp:
2010-06-24T17:00:16+02:00 (14 years ago)
Author:
acc
Message:

ticket #684 step 2: Add in changes from the DEV_r1784_3DF branch

File:
1 edited

Legend:

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

    r1730 r1951  
    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 
     
    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 
     
    202204 
    203205            ! read after data 
     206            ipk = SIZE( sd(jf)%fdta, 3 ) 
    204207            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 
    205208               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) ) 
     209               DO jk = 1, ipk 
     210                  CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,jk,2), sd(jf)%nrec_a(1) ) 
     211               END DO 
    207212            ELSE 
    208                CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     213               IF( ipk == 1 ) THEN  
     214                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 
     215               ELSE 
     216                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 
     217               ENDIF 
    209218            ENDIF 
    210219            sd(jf)%rotn(2) = .FALSE. 
     
    245254                         utmp(:,:) = 0.0 
    246255                         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(:,:) 
     256                         ! 
     257                         DO jk = 1, SIZE( sd(kf)%fdta, 3 ) 
     258                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 
     259                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 
     260                            sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 
     261                            sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 
     262                         END DO 
     263                         ! 
    251264                         sd(jf)%rotn(nf) = .TRUE. 
    252265                         sd(kf)%rotn(nf) = .TRUE. 
     
    280293               ztintb =  1. - ztinta 
    281294!CDIR COLLAPSE 
    282                sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) 
     295               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
    283296            ELSE 
    284297               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
     
    288301               ENDIF 
    289302!CDIR COLLAPSE 
    290                sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field 
     303               sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2)   ! piecewise constant field 
    291304  
    292305            ENDIF 
     
    320333      INTEGER :: inrec          ! number of record existing for this variable 
    321334      INTEGER :: kwgt 
     335      INTEGER :: jk             ! vertical loop variable 
     336      INTEGER :: ipk            ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    322337      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    323338      !!--------------------------------------------------------------------- 
     
    339354               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    340355                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record 
    341                   llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
     356                  llprevmth = .TRUE.                                                       ! use previous month file? 
    342357                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    343358               ELSE                                  ! yearly file 
     
    384399 
    385400         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 
     401         ipk = SIZE( sdjf%fdta, 3 ) 
    386402         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    387403            CALL wgt_list( sdjf, kwgt ) 
    388             CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     404            DO jk = 1, ipk 
     405               CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,jk,2), sdjf%nrec_b(1) ) 
     406            END DO 
    389407         ELSE 
    390             CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     408            IF( ipk == 1 ) THEN 
     409               CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 
     410            ELSE 
     411               CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 
     412            ENDIF 
    391413         ENDIF 
    392414         sdjf%rotn(2) = .FALSE. 
     
    534556         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    535557         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
     558      ELSE 
     559         ! build the new filename if climatological data 
     560         IF( sdjf%cltype == 'monthly' )   WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
    536561      ENDIF 
    537562      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
     
    564589         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint 
    565590         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 
     591         sdf(jf)%cltype     = sdf_n(jf)%cltype 
    569592         sdf(jf)%wgtname = " " 
    570593         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
Note: See TracChangeset for help on using the changeset viewer.