Changeset 2818 for branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/SBC

Timestamp:

2011-08-08T10:16:41+02:00 (13 years ago)

Author:

davestorkey

Message:

Bug fixes for the dynspg_ts case.

File:

• branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90 (modified) (13 diffs)

branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

@@ -131 +131 @@
       LOGICAL  ::   llnxtmth   ! open next month file?
       LOGICAL  ::   llstop     ! stop is the file does not exist
+      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields
       REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
       REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
       CHARACTER(LEN=1000) ::   clfmt   ! write format
       !!---------------------------------------------------------------------
+      ll_firstcall = .false.
+      IF( PRESENT(jit) ) THEN
+         IF(kt == nit000 .and. jit == 1) ll_firstcall = .true.
+      ELSE
+         IF(kt == nit000) ll_firstcall = .true.
+      ENDIF
+
       ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
       IF( present(jit) ) THEN 
@@ -146 +154 @@
       imf = SIZE( sd )
       !
-      IF( kt == nit000 ) THEN                      ! initialization
+      IF( ll_firstcall ) THEN                      ! initialization
          IF( PRESENT(map) ) THEN
             DO jf = 1, imf 
@@ -165 +173 @@
          DO jf = 1, imf                            ! ---   loop over field   --- !
             
-            IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000 ) THEN  ! read/update the after data?
+            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN  ! read/update the after data?
 
                IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations
@@ -173 +181 @@
                ENDIF
 
-               CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations
+               IF( PRESENT(jit) ) THEN
+                  CALL fld_rec( kn_fsbc, sd(jf), jit=jit )              ! update record informations
+               ELSE
+                  CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations
+               ENDIF
 
                ! do we have to change the year/month/week/day of the forcing field?? 
@@ -256 +268 @@
                ! temporal interpolation weights
                ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp )
-               IF( PRESENT(map) ) THEN 
-                  IF(lwp) WRITE(numout,*) '============================================'
-                  IF(lwp) WRITE(numout,*) 'Output from fld_read(map) on timestep ',kt
-                  IF(lwp) WRITE(numout,*) '============================================'
-                  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
-               ENDIF
                ztintb =  1. - ztinta
 !CDIR COLLAPSE
@@ -433 +439 @@
 
 
-   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore )
+   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_rec  ***
@@ -447 +453 @@
       TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables
       LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.)
+      INTEGER  , INTENT(in   ), OPTIONAL ::   jit       ! index of barotropic subcycle
                                                         ! used only if sdjf%ln_tint = .TRUE.
       !!
@@ -480 +487 @@
             !                            
             ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5
+            IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp)
             sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
             ! swap at the middle of the year
@@ -508 +516 @@
             !                            
             ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5
+            IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp)
             imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
             IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
@@ -535 +544 @@
          ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step
          ztmp = ztmp + 0.01 * rdttra(1)                          ! add 0.01 time step to avoid truncation error 
+         IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp)
          IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record
             !
@@ -687 +697 @@
       !!----------------------------------------------------------------------
       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
-      USE wrk_nemo, ONLY: utmp => wrk_2d_4, vtmp => wrk_2d_5      ! 2D workspace
+      USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25      ! 2D workspace
       !!
       INTEGER  , INTENT(in   )               ::   kt        ! ocean time step
@@ -699 +709 @@
       !!---------------------------------------------------------------------
 
-      IF(wrk_in_use(2, 4,5) ) THEN
+      IF(wrk_in_use(2, 24,25) ) THEN
          CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.')   ;   RETURN
       END IF
@@ -736 +746 @@
        END DO
       !
-      IF(wrk_not_released(2, 4,5) )    CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.')
+      IF(wrk_not_released(2, 24,25) )    CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.')
       !
    END SUBROUTINE fld_rot