Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC

Timestamp:

2010-12-27T18:33:53+01:00 (14 years ago)

Author:

rblod

Message:

Update NEMOGCM from branch nemo_v3_3_beta

Location:

trunk/NEMOGCM/NEMO/OPA_SRC/SBC

Files:

• albedo.F90 (modified) (1 diff, 1 prop)
• cpl_oasis3.F90 (modified) (5 diffs, 1 prop)
• cpl_oasis4.F90 (modified) (7 diffs, 1 prop)
• fldread.F90 (modified) (33 diffs)
• geo2ocean.F90 (modified) (3 diffs, 1 prop)
• oasis4_date.F90 (modified) (1 diff, 1 prop)
• sbc_ice.F90 (modified) (4 diffs)
• sbc_oce.F90 (modified) (4 diffs)
• sbcana.F90 (modified) (2 diffs)
• sbcapr.F90 (copied) (copied from branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90)
• sbcblk_clio.F90 (modified) (28 diffs)
• sbcblk_core.F90 (modified) (26 diffs)
• sbccpl.F90 (modified) (13 diffs)
• sbcdcy.F90 (copied) (copied from branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90)
• sbcflx.F90 (modified) (4 diffs)
• sbcfwb.F90 (modified) (9 diffs)
• sbcice_if.F90 (modified) (3 diffs)
• sbcice_lim.F90 (modified) (15 diffs)
• sbcice_lim_2.F90 (modified) (8 diffs)
• sbcmod.F90 (modified) (14 diffs)
• sbcrnf.F90 (modified) (11 diffs)
• sbcssm.F90 (modified) (7 diffs)
• sbcssr.F90 (modified) (6 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

@@ -45 +45 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

@@ -29 +29 @@
    USE mod_prism_put_proto          ! OASIS3 prism module for snding
    USE mod_prism_get_proto          ! OASIS3 prism module for receiving
+   USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency
    USE par_oce                      ! ocean parameters
    USE dom_oce                      ! ocean space and time domain
@@ -61 +62 @@
    PUBLIC cpl_prism_snd
    PUBLIC cpl_prism_rcv
+   PUBLIC cpl_prism_freq
    PUBLIC cpl_prism_finalize
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Header$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -210 +212 @@
       !! * Arguments
       !!
-      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable index in the array
       INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
       INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
@@ -247 +249 @@
       !!      like stresses and fluxes from the coupler or remote application.
       !!----------------------------------------------------------------------
-      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable index in the array
       INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
       REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
@@ -293 +295 @@
 
 
+   FUNCTION cpl_prism_freq( kid )  
+
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_freq  ***
+      !!
+      !! ** Purpose : - send back the coupling frequency for a particular field
+      !!----------------------------------------------------------------------
+      INTEGER,INTENT( IN )   :: kid              ! variable index 
+      INTEGER                :: cpl_prism_freq   ! coupling frequency
+      cpl_prism_freq = ig_def_freq( kid )
+
+   END FUNCTION cpl_prism_freq
+
+
    SUBROUTINE cpl_prism_finalize
 

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90

@@ -1 +1 @@
 MODULE cpl_oasis4
    !!======================================================================
-   !!                    ***  MODULE cpl_oasis4  ***
+   !!                    ***  MODULE cpl_oasis  ***
    !! Coupled O/A : coupled ocean-atmosphere case using OASIS4
-   !!               special case: OPA/LIM coupled to ECHAM5
    !!=====================================================================
    !! History :   
@@ -11 +10 @@
    !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
    !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
-   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
-   !!   " "  !  05-12  (R. Hill, Met. Office) Tweaks and hacks to get NEMO/O4 working
-   !!   " "  !  06-02  (R. Redler, W. Park) Bug fixes and updates according to the OASIS3 interface
-   !!   " "  !  06-02  (R. Redler) app/grid/grid_name from namelist
+   !!   " "  !  06-01  (W. Park) modification of physical part
+   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
+   !!   " "  !  2010   (E. Maisonnave and S. Masson) complete rewrite
    !!----------------------------------------------------------------------
 #if defined key_oasis4
    !!----------------------------------------------------------------------
    !!   'key_oasis4'                    coupled Ocean/Atmosphere via OASIS4
+   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   cpl_prism_init     : initialization of coupled mode communication
    !!   cpl_prism_define   : definition of grid and fields
-   !!   cpl_prism_send     : send out fields in coupled mode
-   !!   cpl_prism_recv     : receive fields in coupled mode
+   !!   cpl_prism_snd     : snd out fields in coupled mode
+   !!   cpl_prism_rcv     : receive fields in coupled mode
+   !!   cpl_prism_update_time   : update date sent to Oasis
    !!   cpl_prism_finalize : finalize the coupled mode communication
    !!----------------------------------------------------------------------
-   !! * Modules used
-!##################### WARNING coupled mode ###############################
-!##################### WARNING coupled mode ###############################
-!   Following line must be enabled if coupling with OASIS
-!   USE prism                        ! prism module
-!##################### WARNING coupled mode ###############################
-!##################### WARNING coupled mode ###############################
-#if defined key_mpp_mpi
-   USE lib_mpp, only : mppsize, mpprank   ! message passing
-   USE lib_mpp, only : mppsend            ! message passing
-   USE lib_mpp, only : mpprecv            ! message passing
-#endif
+   USE prism              ! OASIS4 prism module
+   USE par_oce                      ! ocean parameters
    USE dom_oce                      ! ocean space and time domain
+   USE domwri                       ! ocean space and time domain
    USE in_out_manager               ! I/O manager
-   USE par_oce                      !
-   USE phycst, only : rt0           ! freezing point of sea water
-   USE oasis4_date                  ! OASIS4 date declarations in
-                                    ! PRISM compatible format
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
    IMPLICIT NONE
+   PRIVATE
 !
-! Exchange parameters for coupling ORCA-LIM with ECHAM5
-!
-#if defined key_cpl_ocevel
-   INTEGER, PARAMETER         :: nsend =  6
-#else
-   INTEGER, PARAMETER         :: nsend =  4
-#endif
-
-#if defined key_cpl_discharge
-   INTEGER, PARAMETER         :: nrecv = 20
-#else
-   INTEGER, PARAMETER         :: nrecv = 17
-#endif
-
-   INTEGER, DIMENSION(nsend)  :: send_id
-   INTEGER, DIMENSION(nrecv)  :: recv_id
-
-   CHARACTER(len=32)          :: cpl_send (nsend)
-   CHARACTER(len=32)          :: cpl_recv (nrecv)
-
-   CHARACTER(len=16)          :: app_name       ! application name for OASIS use
-   CHARACTER(len=16)          :: comp_name      ! name of this PRISM component
-   CHARACTER(len=16)          :: grid_name      ! name of the grid
-   CHARACTER(len=1)           :: c_mpi_send
-
-! The following now come in via new module oasis4_date
-!   TYPE(PRISM_Time_struct), PUBLIC    :: dates          ! date info for send operation
-!   TYPE(PRISM_Time_struct), PUBLIC    :: dates_bound(2) ! date info for send operation
-!   TYPE(PRISM_Time_struct), PUBLIC    :: dater          ! date info for receive operation
-!   TYPE(PRISM_Time_struct), PUBLIC    :: dater_bound(2) ! date info for receive operation
-!   TYPE(PRISM_Time_struct), PUBLIC    :: tmpdate
-
-   PRIVATE
-
-   INTEGER, PARAMETER         :: localRoot  = 0
-
-   INTEGER                    :: localRank      ! local MPI rank
-   INTEGER                    :: localSize      ! local MPI size
-   INTEGER                    :: localComm      ! local MPI size
-   LOGICAL                    :: commRank       ! true for ranks doing OASIS communication
-   INTEGER                    :: comp_id        ! id returned by prism_init_comp
-
-   INTEGER                    :: range(5)
-
-   LOGICAL, SAVE              :: prism_was_initialized
-   LOGICAL, SAVE              :: prism_was_terminated
-   INTEGER, SAVE              :: write_grid
-
-   INTEGER                    :: ierror         ! return error code
-
-#ifdef key_cpl_rootexchg
-   LOGICAL                               :: rootexchg =.true.     ! logical switch 
-#else
-   LOGICAL                               :: rootexchg =.false.    ! logical switch
-#endif
-
-   REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for exchange
-   REAL(wp), DIMENSION(:),   ALLOCATABLE :: buffer ! Temporary buffer for exchange
-   INTEGER, DIMENSION(:,:),  ALLOCATABLE :: ranges ! Temporary buffer for exchange
-
-   DOUBLE PRECISION           :: date_incr
+!   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.    ! coupled flag
+   INTEGER                    :: ncomp_id           ! id returned by prism_init_comp
+   INTEGER                    :: nerror             ! return error code
+   INTEGER, PUBLIC            :: OASIS_Rcv  = 1     ! return code if received field
+   INTEGER, PUBLIC            :: OASIS_idle = 0     ! return code if nothing done by oasis
+
+   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields
+   
+   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
+      LOGICAL            ::   laction   ! To be coupled or not
+      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
+      CHARACTER(len = 1) ::   clgrid    ! Grid type  
+      REAL(wp)           ::   nsgn      ! Control of the sign change
+      INTEGER            ::   nid       ! Id of the field
+   END TYPE FLD_CPL
+
+   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving
+
+   TYPE(PRISM_Time_struct), PUBLIC    :: date            ! date info for send operation
+   TYPE(PRISM_Time_struct), PUBLIC    :: date_bound(2)   ! date info for send operation
+
 
    !! Routine accessibility
    PUBLIC cpl_prism_init
    PUBLIC cpl_prism_define
-   PUBLIC cpl_prism_send
-   PUBLIC cpl_prism_recv
+   PUBLIC cpl_prism_snd
+   PUBLIC cpl_prism_rcv
+   PUBLIC cpl_prism_update_time
    PUBLIC cpl_prism_finalize
 
-   PUBLIC send_id, recv_id
-
    !!----------------------------------------------------------------------
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$
+   !! $Header$ 
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -125 +76 @@
 CONTAINS
 
-   SUBROUTINE cpl_prism_init( localCommunicator )
-
-      IMPLICIT NONE
+   SUBROUTINE cpl_prism_init (kl_comm) 
 
       !!-------------------------------------------------------------------
@@ -137 +86 @@
       !! ** Method  :   OASIS4 MPI communication 
       !!--------------------------------------------------------------------
-      !! * Arguments
-      !!
-      INTEGER, INTENT(OUT)       :: localCommunicator
-      !!
-      !! * Local declarations
-      !!
-
-      NAMELIST/nam_mpp/ app_name, comp_name, c_mpi_send, grid_name
-
-      !!
-      !!--------------------------------------------------------------------
-      !!
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'cpl_prism_init : initialization in coupled ocean/atmosphere case'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*)
-     
-#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily
-
-#if !defined key_oasis4
-! The following is not necessarily a valid peice of checking
-
-      IF(lwp) WRITE(numout,cform_err)
-      IF(lwp) WRITE(numout,*) ' key_coupled and key_flx_bulk_* key_flx_forced_daily are incompatible'
-      nstop = nstop + 1
-
-#endif
-
-#endif
-
-      REWIND( numnam )
-      READ  ( numnam, nam_mpp )
-      REWIND( numnam )
-
-      !------------------------------------------------------------------
-      ! 1st Initialize the PRISM system for the application
-      !------------------------------------------------------------------
-
-      CALL prism_initialized (prism_was_initialized, ierror)
-      IF ( ierror /= PRISM_Success ) &
-         CALL prism_abort( comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_initialized' )
-
-      IF ( .NOT. prism_was_initialized ) THEN
-         CALL prism_init( app_name, ierror )
-         IF ( ierror /= PRISM_Success ) &
-            CALL prism_abort(comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_init')
-         prism_was_initialized = .true.
-      ELSE
-         call prism_abort(comp_id, 'OPA9.0', 'cpl_prism_init: Do not initialize prism twice!')
-      ENDIF
-      !
-      ! Obtain the actual dates and date bounds
-      !
-      ! date is determined by adding days since beginning of
-      !   the run to the corresponding initial date. Note that
-      !   OPA internal info about the start date of the experiment
-      !   is bypassed. Instead we rely sololy on the info provided
-      !   by the SCC.xml file. 
-      !
-      dates   = PRISM_Jobstart_date
-
-      WRITE(6,*) "PRISM JOB START DATE IS", dates
-
-      !
-      ! upper bound is determined by adding half a time step
-      !
-      tmpdate = dates
-      date_incr = rdttra(1)/2.0
-      CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-      dates_bound(2) = tmpdate
-      !
-      ! lower bound is determined by half distance to date from previous run
-      !
-      tmpdate   = dates
-      date_incr = ( adatrj - adatrj0 ) * 43200.0
-      CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-      dates_bound(1) = tmpdate
-
-      dater = dates
-      dater_bound(1) = dates_bound(1) 
-      dater_bound(2) = dates_bound(2) 
-
-      WRITE(6,*) "DATE send and rec BOUNDS",dater_bound
-      WRITE(6,*) "OTHER BITS FOR DATE",rdttra(1)
-      WRITE(6,*) "adatrj/0",adatrj,adatrj0,date_incr
+      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model
+      !
+      
+      CALL prism_init( 'nemo', nerror )
 
       !------------------------------------------------------------------
       ! 2nd Initialize the PRISM system for the component
       !------------------------------------------------------------------
-
-      CALL prism_init_comp ( comp_id, comp_name, ierror )
-      IF ( ierror /= PRISM_Success ) &
-         CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_init_comp')
-
-      WRITE(6,*) "COMPLETED INIT_COMP",comp_name,comp_id
-
-      !------------------------------------------------------------------
-      ! 3rd Get an MPI communicator for OPA local communication
-      !------------------------------------------------------------------
-
-      CALL prism_get_localcomm ( comp_id, localComm, ierror )
-      IF ( ierror /= PRISM_Success ) &
-         CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_get_localcomm' )
-
-      localCommunicator = localComm
-
-       WRITE(6,*) "COMPLETED GET_LOCALCOMM",comp_name,comp_id
+      CALL prism_init_comp( ncomp_id, 'oceanx', nerror )
+      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp' )
+
+      !------------------------------------------------------------------
+      ! 3rd Get an MPI communicator fr OPA local communication
+      !------------------------------------------------------------------
+      CALL prism_get_localcomm( ncomp_id, kl_comm, nerror )
+      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_get_localcomm' )
 
 
@@ -249 +107 @@
 
 
-   SUBROUTINE cpl_prism_define ()
-
-      IMPLICIT NONE
+   SUBROUTINE cpl_prism_define (krcv, ksnd)
 
       !!-------------------------------------------------------------------
@@ -261 +117 @@
       !! ** Method  :   OASIS4 MPI communication 
       !!--------------------------------------------------------------------
-      !! * Arguments
-      !!
-      !! * Local declarations
-
-      INTEGER                    :: grid_id(2)     ! id returned by prism_def_grid
-
-      INTEGER                    :: upoint_id(2), &
-                                    vpoint_id(2), &
-                                    tpoint_id(2), &
-                                    fpoint_id(2)   ! ids returned by prism_set_points
-
-      INTEGER                    :: umask_id(2), &
-                                    vmask_id(2), &
-                                    tmask_id(2), &
-                                    fmask_id(2)    ! ids returned by prism_set_mask
-
-      INTEGER                    :: grid_type      ! PRISM grid type
-
-      INTEGER                    :: shape(2,3)     ! shape of arrays passed to PSMILe
-      INTEGER                    :: nodim(2)
+      INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields
+      !
+      INTEGER, DIMENSION(4)      :: igrid     ! ids returned by prism_def_grid
+      INTEGER, DIMENSION(4)      :: iptid     ! ids returned by prism_set_points
+
+      INTEGER, DIMENSION(4)      :: imskid  ! ids returned by prism_set_mask
+      INTEGER, DIMENSION(4)      :: iishift     ! 
+      INTEGER, DIMENSION(4)      :: ijshift    ! 
+      INTEGER, DIMENSION(4)      :: iioff     ! 
+      INTEGER, DIMENSION(4)      :: ijoff    ! 
+      INTEGER, DIMENSION(4)      :: itmp    ! 
+      INTEGER, DIMENSION(1,3)    :: iextent    ! 
+      INTEGER, DIMENSION(1,3)    :: ioffset    ! 
+
+
+      INTEGER                    :: ishape(2,3)     ! shape of arrays passed to PSMILe
       INTEGER                    :: data_type      ! data type of transients
 
-      INTEGER                    :: nbr_corners
 
       LOGICAL                    :: new_points
       LOGICAL                    :: new_mask
-      LOGICAL                    :: mask(jpi,jpj,jpk)
-
-      INTEGER                    :: ji, jj, jk     ! local loop indicees
-
-      CHARACTER(len=32)          :: cpl_send (nsend)
-      CHARACTER(len=32)          :: cpl_recv (nrecv)
-
-      CHARACTER(len=32)          :: grid_name      ! name of the grid
-      CHARACTER(len=32)          :: point_name     ! name of the grid points
-
-      REAL(kind=wp), ALLOCATABLE :: rclon(:,:,:)
-      REAL(kind=wp), ALLOCATABLE :: rclat(:,:,:)
-      REAL(kind=wp), ALLOCATABLE :: rcz  (:,:)
-
+      LOGICAL                    :: llmask(jpi,jpj,1)
+
+      INTEGER                    :: ji, jj, jg, jc     ! local loop indicees
+      INTEGER                    :: ii,ij     ! index
+      INTEGER, DIMENSION(1)      :: ind     ! index
+
+      CHARACTER(len=32)          :: clpt_name     ! name of the grid points
+      CHARACTER(len=7)           :: cltxt 
+      CHARACTER(len=1), DIMENSION(4) :: clgrd = (/ 'T','U','V','F' /)     ! name of the grid points
+
+      REAL(kind=wp), DIMENSION(jpi,jpj,4)  :: zclo, zcla
+      REAL(kind=wp), DIMENSION(jpi,jpj  )  :: zlon, zlat
+
+      TYPE(PRISM_Time_struct)    :: tmpdate
+      INTEGER                    :: idate_incr      ! date increment
+      !!
       !!--------------------------------------------------------------------
-     
+
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
       IF(lwp) WRITE(numout,*)
-     
-#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily
-
-#if !defined key_oasis4
-! The problem with the following is that it ASSUMES we're only ever coupling to an atmosphere
-! which is not necessarily the case. Prevent this test temporarily for NEMOGAM development.
-
-      IF(lwp) WRITE(numout,cform_err)
-      IF(lwp) WRITE(numout,*) ' key_coupled and key_flx_bulk_... are incompatible'
-      nstop = nstop + 1
-
-#endif
-
-#endif
-
-      ! -----------------------------------------------------------------
-      ! ... Some initialisation
-      ! -----------------------------------------------------------------
-
-      send_id = 0
-      recv_id = 0
-
-#if defined key_mpp_mpi
-
-      ! -----------------------------------------------------------------
-      ! ... Some MPI stuff relevant for optional exchange via root only
-      ! -----------------------------------------------------------------
-
-      commRank = .false.
-
-      localRank = mpprank ! from lib_mpp
-      localSize = mppsize ! from lib_mpp
-
-      IF(lwp) WRITE(numout,*) "CALLING DEFINE"
-
-      IF ( rootexchg ) THEN
-         IF ( localRank == localRoot ) commRank = .true.
-      ELSE
-         commRank = .true.
-      ENDIF
-
-#else
-      !
-      ! For non-parallel configurations the one and only process ("localRoot")
-      ! takes part in the communication
-      ! 
-      localRank = localRoot
-      commRank = .true.
-
-#endif
-
-      ! -----------------------------------------------------------------
+
+      !
       ! ... Allocate memory for data exchange
-      ! -----------------------------------------------------------------
-
-
-      IF(lwp) WRITE(numout,*) "Abbout to allocate exfld",jpi,jpj
-
-      ALLOCATE(exfld(1:jpi,1:jpj), stat = ierror)
-      IF (ierror > 0) THEN
-         CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating Reals')
+      !
+      ALLOCATE( exfld(nlei-nldi+1, nlej-nldj+1, 1), stat = nerror )
+      IF ( nerror > 0 ) THEN
+         CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld' )
          RETURN
       ENDIF
 
-      IF ( rootexchg .and. localRank == localRoot ) THEN
-         ALLOCATE(ranges(5,0:localSize-1), stat = ierror)
-         IF (ierror > 0) THEN
-            CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating Integer')
-            RETURN
-         ENDIF
-      ENDIF
-
-      !------------------------------------------------------------------
-      ! 1st Declare the local grid (ORCA tripolar) characteristics for
-      !     surface coupling. The halo regions must be excluded. For
-      !     surface coupling it is sufficient to specify only one
-      !     vertical z-level.
-      !------------------------------------------------------------------
-
-      grid_type = PRISM_irrlonlat_regvrt
-
-      IF(lwp) WRITE(numout,*) "Set grid type"
-
-
-      ! -----------------------------------------------------------------
-      ! ... Define the shape of the valid region without the halo.
+
+      ! -----------------------------------------------------------------
+      ! ... Define the shape of the valid region without the halo and overlaps between cpus
       !     For serial configuration (key_mpp_mpi not being active)
       !     nl* is set to the global values 1 and jp*glo.
       ! -----------------------------------------------------------------
 
-      IF ( rootexchg ) THEN
-         shape(1,1) = 1+jpreci
-         shape(2,1) = jpiglo-jpreci
-         shape(1,2) = 1+jpreci
-         shape(2,2) = jpjglo-jpreci
-         shape(1,3) = 1
-         shape(2,3) = 1
-      ELSE
-         shape(1,1) = 1+jpreci
-         shape(2,1) = jpi-jpreci
-         shape(1,2) = 1+jpreci
-         shape(2,2) = jpj-jpreci
-         shape(1,3) = 1
-         shape(2,3) = 1
-      ENDIF
-
-      IF(lwp) WRITE(numout,*) "commrank is", commRank
-
-      IF ( commRank ) THEN
-
-         IF(lwp) WRITE(numout,*) "CALLING DEF_GRID"
-
-         IF(lwp) WRITE(numout,*) "grid name",grid_name
-         IF(lwp) WRITE(numout,*) " shape",shape
-         IF(lwp) WRITE(numout,*) "grid type",grid_type
-
-         CALL prism_def_grid ( grid_id(1), grid_name, comp_id, shape, &
-              grid_type, ierror )
-         IF ( ierror /= PRISM_Success ) THEN
-            PRINT *, 'OPA cpl_prism_define: Failure in prism_def_grid'
-            CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_grid')
+      ishape(:,1) = (/ 1, nlei-nldi+1 /)
+      ishape(:,2) = (/ 1, nlej-nldj+1 /)
+      ishape(:,3) = (/ 1,           1 /)
+          
+      DO ji = 1, 4
+         CALL prism_def_grid( igrid(ji), 'orca'//clgrd(ji), ncomp_id, ishape, PRISM_irrlonlat_regvrt, nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
+            &                                                        'Failure in prism_def_grid of '//clgrd(jg)//'-point' )
+      END DO
+      
+      ! -----------------------------------------------------------------
+      ! ... Define the partition 
+      ! -----------------------------------------------------------------
+      
+      iextent(1,:) = (/    nlei-nldi+1,    nlej-nldj+1, 1 /)
+      ioffset(1,:) = (/ nldi-1+nimpp-1, nldj-1+njmpp-1, 0 /)
+      
+      DO ji = 1, 4
+         CALL prism_def_partition( igrid(ji), 1, ioffset, iextent, nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
+            &                                                        'Failure in prism_def_partition of '//clgrd(jg)//'-point' )
+      END DO
+
+      ! -----------------------------------------------------------------
+      ! ... Define the elements, i.e. specify the corner points for each
+      !     volume element. In case OPA runs on level coordinates (regular
+      !     in the vertical) we only need to give the 4 horizontal corners
+      !     for a volume element plus the vertical position of the upper
+      !     and lower face. Nevertheless the volume element has 8 corners.
+      ! -----------------------------------------------------------------
+      
+      iioff(:) = (/0,1,0,1/)
+      ijoff(:) = (/0,0,1,1/) 
+      iishift(:) = (/0,1,1,0/)
+      ijshift(:) = (/0,0,1,1/)
+
+      DO jg = 1, 4    ! ... the t,u,v,f-points
+
+         cltxt = clgrd(jg)//'-point'
+         
+         ! -----------------------------------------------------------------
+         ! ... Convert OPA masks to logicals and define the masks
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1)  ) == 1.
+         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1)  ) == 1.
+         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1)  ) == 1.
+         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1)  ) == 1.
+!         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1) * dom_uniq('T') ) == 1.
+!         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1) * dom_uniq('U') ) == 1.
+!         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1) * dom_uniq('V') ) == 1.
+!         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1) * dom_uniq('F') ) == 1.
+         END SELECT
+         CALL prism_set_mask( imskid(jg), igrid(jg), ishape, llmask(nldi:nlei, nldj:nlej, 1), .TRUE., nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_mask for '//cltxt )
+
+         ! -----------------------------------------------------------------
+         ! ... Define the corners
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
+         CASE(2)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
+         CASE(3)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:) 
+         CASE(4)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
+         END SELECT
+
+         DO jc = 1, 4   ! corner number (anti-clockwise, starting from the bottom left corner)
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1   ! NO vector opt.
+                  ii = ji-1 + iioff(jg) + iishift(jc)
+                  ij = jj-1 + ijoff(jg) + ijshift(jc)
+                  zclo(ji,jj,jc) = zlon(ii,ij)
+                  zcla(ji,jj,jc) = zlat(ii,ij)
+               END DO
+            END DO
+            CALL lbc_lnk( zclo(:,:,jc), clgrd(jg), 1. )   ;   CALL lbc_lnk( zcla(:,:,jc), clgrd(jg), 1. )
+         END DO
+
+         CALL prism_set_corners( igrid(jg), 8, ishape, zclo(nldi:nlei, nldj:nlej,:),   &
+            &                                          zcla(nldi:nlei, nldj:nlej,:), RESHAPE( (/-1.,1./), (/1,2/) ), nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_corners of '//cltxt )    
+
+         ! -----------------------------------------------------------------
+         ! ... Define the center points
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
+         CASE(2)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:)
+         CASE(3)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
+         CASE(4)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
+         END SELECT
+
+         CALL prism_set_points ( iptid(jg), cltxt, igrid(jg), ishape, zlon(nldi:nlei, nldj:nlej),   &
+         &                                                            zlat(nldi:nlei, nldj:nlej), (/0./), .TRUE., nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_points '//cltxt )
+
+      END DO
+
+      ! ... Announce send variables. 
+      !
+      DO ji = 1, ksnd
+         IF ( ssnd(ji)%laction ) THEN 
+            
+            itmp(:) = 0
+            WHERE( clgrd == ssnd(ji)%clgrid  ) itmp = 1
+            ind(:) = maxloc( itmp )
+            WRITE(6,*) ' grid for field ', ind(1), ssnd(ji)%clname
+             ind(1) = 1
+
+            CALL prism_def_var( ssnd(ji)%nid, ssnd(ji)%clname, igrid(ind(1)), iptid(ind(1)),  imskid(ind(1)), (/ 3, 0/),   &
+               &                ishape, PRISM_Double_Precision, nerror )
+            IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(ji)%nid, 'cpl_prism_define',   &
+               &                                               'Failure in prism_def_var for '//TRIM(ssnd(ji)%clname))
+
          ENDIF
-
-         !------------------------------------------------------------------
-         ! 2nd Declare the geometic information for this grid.
-         !------------------------------------------------------------------
-
-         ! -----------------------------------------------------------------
-         ! ... Redefine shape which may now include the halo region as well.
-         ! -----------------------------------------------------------------
-
-         shape(1,1) = 1
-         shape(2,1) = jpi
-         shape(1,2) = 1
-         shape(2,2) = jpj
-         shape(1,3) = 1
-         shape(2,3) = 1
-
-         IF(lwp) WRITE(numout,*) "redefined shape",shape
-
-         ! -----------------------------------------------------------------
-         ! ... Define the elements, i.e. specify the corner points for each
-         !     volume element. In case OPA runs on level coordinates (regular
-         !     in the vertical) we only need to give the 4 horizontal corners
-         !     for a volume element plus the vertical position of the upper
-         !     and lower face. Nevertheless the volume element has 8 corners.
-         ! -----------------------------------------------------------------
-
-         !
-         ! ... Treat corners in the horizontal plane
-         !
-         ALLOCATE(rclon(shape(1,1):shape(2,1),shape(1,2):shape(2,2),4), &
-              STAT=ierror)
-         IF ( ierror /= 0 ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rclon')
-
-         ALLOCATE(rclat(shape(1,1):shape(2,1),shape(1,2):shape(2,2),4), &
-              STAT=ierror)
-         IF ( ierror /= 0 ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rclon')
-
-         nbr_corners = 8
-         !
-         ! ... Set right longitudes and upper latitudes
-         !
-         DO jj = shape(1,2), shape(2,2)
-            DO ji = shape(1,1), shape(2,1)
-               rclon(ji,jj,1) = glamu(ji,jj)
-               rclon(ji,jj,2) = glamu(ji,jj)
-               rclat(ji,jj,2) = gphiv(ji,jj)
-               rclat(ji,jj,3) = gphiv(ji,jj)
-            ENDDO
-         ENDDO
-         !
-         ! ... Set the lower latitudes
-         !
-         DO jj = shape(1,2)+1, shape(2,2)
-            DO ji = shape(1,1), shape(2,1)
-               rclat(ji,jj-1,1) = rclat(ji,jj,2)
-               rclat(ji,jj-1,4) = rclat(ji,jj,3)
-            ENDDO
-         ENDDO
-         !
-         ! ... Set the left longitudes
-         !
-         DO jj = shape(1,2), shape(2,2)
-            DO ji = shape(1,1)+1, shape(2,1)
-               rclon(ji-1,jj,3) = rclon(ji,jj,2)
-               rclon(ji-1,jj,4) = rclon(ji,jj,1)
-            ENDDO
-         ENDDO
-         !
-         ! ... Set the lowermost latitudes 
-         !
-         DO jj = shape(1,2), shape(1,2)
-            DO ji = shape(1,1), shape(2,1)
-               rclat(ji,jj,1) = 2.0*gphit(ji,jj)-rclat(ji,jj,2)
-               rclat(ji,jj,4) = 2.0*gphit(ji,jj)-rclat(ji,jj,4)
-            ENDDO
-         ENDDO
-         !
-         ! ... Set the rightmost latitudes 
-         !
-         DO jj = shape(1,2), shape(2,2)
-            DO ji = shape(1,2), shape(1,2)
-               rclon(ji,jj,3) = 2.0*glamt(ji,jj)-rclon(ji,jj,2)
-               rclon(ji,jj,4) = 2.0*glamt(ji,jj)-rclon(ji,jj,1)
-
-               WRITE(76,*) "rclon", ji, jj, rclon(ji,jj,1), &
-                                            rclon(ji,jj,2), &
-                                            rclon(ji,jj,3), &
-                                            rclon(ji,jj,4)
-
-               WRITE(76,*) "rclat", ji, jj, rclat(ji,jj,1), &
-                                            rclat(ji,jj,2), &
-                                            rclat(ji,jj,3), &
-                                            rclat(ji,jj,4)
-
-            ENDDO
-         ENDDO
-
-         !
-         ! ... Treat corners along the vertical axis
-         !
-         ALLOCATE(rcz(shape(1,3):shape(2,3),2), STAT=ierror)
-         IF ( ierror /= 0 ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rcz')
-
-         DO jk = shape(1,3), shape(2,3)
-            rcz(jk,1) = gdepw(jk)
-            rcz(jk,2) = gdepw(jk+1)
-         ENDDO
-
-         IF(lwp) WRITE(numout,*) "ABOUT TO CALL SET CORNERS",shape 
-
-         CALL prism_set_corners ( grid_id(1), nbr_corners, shape, rclon, rclat, &
-              rcz, ierror)
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_corners')
-
-         DEALLOCATE(rclon, rclat, rcz)
-
-         ! -----------------------------------------------------------------
-         ! ... Define the gridpoints  
-         ! -----------------------------------------------------------------
-
-         new_points = .TRUE.
-
-         IF(lwp) WRITE(numout,*) "CALLING SET_POINTS"
-
-         !
-         ! ... the u-points
-         !
-         point_name = 'u-points'
-         CALL prism_set_points ( upoint_id(1), point_name, grid_id(1), shape,      &
-              glamu, gphiu, gdept(shape(1,3):shape(2,3)), new_points, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points upoint_id')
-         !
-         ! ... the v-points
-         !
-
-         IF(lwp) WRITE(numout,*) "CALLING SET_POINTS done u doing v"
-
-         point_name = 'v-points'
-         CALL prism_set_points ( vpoint_id(1), point_name, grid_id(1), shape,      &
-              glamv, gphiv, gdept(shape(1,3):shape(2,3)), new_points, ierror )      
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points vpoint_id')
-         !
-         ! ... the t-points
-         !
-         ! WRITE(76,*) 'CALLING T POINTS', shape
-         ! WRITE(77,*) 'glamt', glamt
-         ! WRITE(78,*) 'gphit', gphit
-         !
-         point_name = 't-points'
-         CALL prism_set_points ( tpoint_id(1), point_name, grid_id(1), shape,   &
-              glamt, gphit, gdept(shape(1,3):shape(2,3)), new_points, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points tpoint_id')
-         !
-         ! ... the f-points
-         !
-         point_name = 'f-points'
-         CALL prism_set_points ( fpoint_id(1), point_name, grid_id(1), shape,   &
-              glamf, gphif, gdept(shape(1,3):shape(2,3)), new_points, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points fpoint_id')
-
-
-         IF(lwp) WRITE(numout,*) "CALLING SET_POINTS done f"
-
-         ! -----------------------------------------------------------------
-         ! ... Convert OPA masks to logicals and define the masks
-         ! -----------------------------------------------------------------
-
-         new_mask = .true.
-
-         mask = (umask == 1)
-         CALL prism_set_mask (umask_id(1), grid_id(1), shape, &
-                 mask(shape(1,1):shape(2,1),                  &
-                      shape(1,2):shape(2,2),                  &
-                      shape(1,3):shape(2,3)),                 &
-              new_mask, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
-
-         mask = (vmask == 1)
-         CALL prism_set_mask (vmask_id(1), grid_id(1), shape, &
-                 mask(shape(1,1):shape(2,1),                  &
-                      shape(1,2):shape(2,2),                  &
-                      shape(1,3):shape(2,3)),                 &
-              new_mask, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
-
-         mask = (tmask == 1)
-         CALL prism_set_mask (tmask_id(1), grid_id(1), shape, &
-                 mask(shape(1,1):shape(2,1),                  &
-                      shape(1,2):shape(2,2),                  &
-                      shape(1,3):shape(2,3)),                 &
-              new_mask, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
-
-         mask = (fmask == 1)
-         CALL prism_set_mask (fmask_id(1), grid_id(1), shape, &
-                 mask(shape(1,1):shape(2,1),                  &
-                      shape(1,2):shape(2,2),                  &
-                      shape(1,3):shape(2,3)),                 &
-              new_mask, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
-
-         IF(lwp) WRITE(numout,*) "DONE ALL THE SET MASKS"
-
-         ! -----------------------------------------------------------------
-         ! ... Define the angles
-         !   This is needed if zonal tau is not oriented E-W and meridional
-         !   tau is not oriented along N-S but rather along local coordinate
-         !   axis. Please check!!!!
-         ! -----------------------------------------------------------------
-
-!rr      cal prism_set_angles ( ..., ierror ) ! not yet supported by OASIS4
-
-         ! -----------------------------------------------------------------
-         ! ... Define the partition 
-         ! -----------------------------------------------------------------
-         
-         IF ( rootexchg ) THEN
-
-            range(1) = nimpp-1+nldi   ! global start in i
-            range(2) = nlei-nldi+1    ! local size in i of valid region
-            range(3) = njmpp-1+nldj   ! global start in j
-            range(4) = nlej-nldj+1    ! local size in j of valid region
-            range(5) = range(2) &
-                     * range(4)       ! local horizontal size
-            !
-            ! Collect ranges from all NEMO procs on the local root process
-            !
-            CALL mpi_gather(range,  5, MPI_INTEGER, &
-                            ranges, 5, MPI_INTEGER, localRoot, localComm, ierror)
-
-            IF ( localRank == localRoot ) THEN
-
-               maxlen = maxval(ranges(5,:))
-
-               ALLOCATE(buffer(1:maxlen), stat = ierror)
-               IF (ierror > 0) THEN
-                  CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating buffer')
-                  RETURN
-               ENDIF
-
-            ENDIF
+      END DO
+      !
+      ! ... Announce received variables. 
+      !
+      DO ji = 1, krcv
+         IF ( srcv(ji)%laction ) THEN 
+
+            itmp(:) = 0
+            WHERE( clgrd == srcv(ji)%clgrid  ) itmp = 1
+            ind(:) = maxloc( itmp )
+            WRITE(6,*) ' grid for field ', ind(1), srcv(ji)%clname
+             ind(1) = 1
+ 
+            CALL prism_def_var( srcv(ji)%nid, srcv(ji)%clname, igrid(ind(1)), iptid(ind(1)), imskid(ind(1)), (/ 3, 0/),   &
+               &                ishape, PRISM_Double_Precision, nerror )
+            IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(ji)%nid, 'cpl_prism_define',   &
+               &                                               'Failure in prism_def_var for '//TRIM(srcv(ji)%clname))
 
          ENDIF
-
-         ! -----------------------------------------------------------------
-         ! ... Define the scalefactors 
-         ! -----------------------------------------------------------------
-
-!rr      WRITE(numout,*) "CALLING SCALEFACTOR"
-!rr      call prism_set_scalefactor ( grid_id(1), shape, e1t, e2t, e3t, ierror )  ! not yet supported by OASIS4
-!rr      WRITE(numout,*) "ABOUT TO DEFINE THE TRANSIENTS"
-
-         !------------------------------------------------------------------
-         ! 3rd Declare the transient variables
-         !------------------------------------------------------------------
-         !
-         ! ... Define symbolic names for the transient fields send by the ocean
-         !     These must be identical to the names specified in the SMIOC file.
-         !
-         cpl_send( 1)='SOSSTSST' ! sea surface temperature              -> sst_io
-         cpl_send( 2)='SITOCEAN' ! sea ice thickness                    -> hicif (only 1 layer available!)
-#if defined key_cpl_albedo
-         cpl_send( 3)='STIOCEAN' ! surface temperature over sea ice     -> tn_ice
-         cpl_send( 4)='SAIOCEAN' ! albedo over sea ice                  -> alb_ice
-#else
-         cpl_send( 3)='SITOCEAN' ! sea ice thickness                    -> hicif (only 1 layer available!)
-         cpl_send( 4)='SNTOCEAN' ! surface snow thickness over sea ice  -> hsnif
-#endif
-#if defined key_cpl_ocevel
-         cpl_send( 5)='SUNOCEAN' ! U-velocity                           -> un
-         cpl_send( 6)='SVNOCEAN' ! V-velocity                           -> vn
-#endif
-         !
-         ! ...  Define symbolic names for transient fields received by the ocean.
-         !      These must be identical to the names specified in the SMIOC file.
-         !
-         ! ...  a) U-Grid fields
-         !
-         cpl_recv( 1)='TXWOCEWU' ! weighted surface downward eastward stress
-         cpl_recv( 2)='TYWOCEWU' ! weighted surface downward northward stress
-         cpl_recv( 3)='TXIOCEWU' ! weighted surface downward eastward stress over ice
-         cpl_recv( 4)='TYIOCEWU' ! weighted surface downward northward stress over ice
-         !
-         ! ...  a) V-Grid fields
-         !
-         cpl_recv( 5)='TXWOCEWV' ! weighted surface downward eastward stress
-         cpl_recv( 6)='TYWOCEWV' ! weighted surface downward northward stress
-         cpl_recv( 7)='TXIOCEWV' ! weighted surface downward eastward stress over ice
-         cpl_recv( 8)='TYIOCEWV' ! weighted surface downward northward stress over ice
-         !
-         ! ...  a) T-Grid fields
-         !
-         cpl_recv( 9)='FRWOCEPE' ! P-E over water                               -> zpew
-         cpl_recv(10)='FRIOCEPE' ! P-E over ice                                 -> zpei
-         cpl_recv(11)='FRROCESN' ! surface downward snow fall                   -> zpsol
-         cpl_recv(12)='FRIOCEEV' ! surface upward snow flux where sea ice       -> zevice
-
-         cpl_recv(13)='QSWOCESR' ! surface net downward shortwave flux          -> qsr_oce
-         cpl_recv(14)='QSWOCENS' ! surface downward non-solar heat flux in air  -> qnsr_oce
-         cpl_recv(15)='QSIOCESR' ! solar heat flux on sea ice                   -> qsr_ice
-         cpl_recv(16)='QSIOCENS' ! non-solar heat flux on sea ice               -> qnsr_ice
-         cpl_recv(17)='QSIOCEDQ' ! non-solar heat flux derivative               -> dqns_ice
-
-#ifdef key_cpl_discharge
-         cpl_recv(18)='FRWOCEIS' ! ice discharge into ocean                     -> calving
-         cpl_recv(19)='FRWOCERD' ! river discharge into ocean                   -> zrunriv
-         cpl_recv(20)='FRWOCECD' ! continental discharge into ocean             -> zruncot
-#endif
-         IF ( wp == 4 ) data_type = PRISM_REAL
-         IF ( wp == 8 ) data_type = PRISM_DOUBLE_PRECISION
-
-         nodim(1) = 3 ! check
-         nodim(2) = 0
-         !
-         ! ... Announce send variables, all on T points. 
-         !
-         DO ji = 1, nsend
-            ! if ( ji == 2 ) ; then ; nodim(2) = 2 ; else ; nodim(2) = 0 ; endif
-            CALL prism_def_var (send_id(ji), cpl_send(ji), grid_id(1), &
-                 tpoint_id(1), tmask_id(1), nodim, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Success ) THEN
-               PRINT *, 'Failed to define transient ', ji, TRIM(cpl_send(ji))
-               CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         nodim(1) = 3 ! check
-         nodim(2) = 0
-         !
-         ! ... Announce recv variables. 
-         !
-         ! ... a) on U points
-         !
-         DO ji = 1, 4
-            CALL prism_def_var (recv_id(ji), cpl_recv(ji), grid_id(1), &
-                 upoint_id(1), umask_id(1), nodim, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Success ) THEN
-               PRINT *, 'Failed to define transient ', ji, TRIM(cpl_recv(ji))
-               CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         ! ... b) on V points
-         !
-         DO ji = 5, 8 
-            CALL prism_def_var (recv_id(ji), cpl_recv(ji), grid_id(1), &
-                 vpoint_id(1), vmask_id(1), nodim, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Success ) THEN
-               PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji))
-               CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         ! ... c) on T points
-         !
-         DO ji = 9, nrecv
-            CALL prism_def_var (recv_id(ji), "SORUNOFF", grid_id(1), &
-                 tpoint_id(1), tmask_id(1), nodim, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Success ) THEN
-               PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji))
-               CALL prism_abort ( comp_id, 'OPA9.0', 'OPA cpl_prism_define: Failure in prism_def_var')
-            ENDIF
-         ENDDO
-
-      ENDIF ! commRank
-
-      !------------------------------------------------------------------
-      ! 4th End of definition phase
-      !------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*) "ABOUT TO CALL PRISM_ENDDEF" 
-
-      CALL prism_enddef(ierror)
-
-      IF(lwp) WRITE(numout,*) "DONE ENDDEF",ierror
-
-      IF ( ierror /= PRISM_Success ) &
-         CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_enddef')
-        
-      IF(lwp) WRITE(numout,*) "ALL DONE, EXITING PRISM SET UP PHASE"
- 
+      END DO
+      
+      !------------------------------------------------------------------
+      ! End of definition phase
+      !------------------------------------------------------------------
+      
+      CALL prism_enddef( nerror )
+      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
+      
    END SUBROUTINE cpl_prism_define
-
-
-
-   SUBROUTINE cpl_prism_send( var_id, date, data_array, info )
-
-      IMPLICIT NONE
+   
+   
+   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
 
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_send  ***
+      !!              ***  ROUTINE cpl_prism_snd  ***
       !!
       !! ** Purpose : - At each coupling time-step,this routine sends fields
       !!      like sst or ice cover to the coupler or remote application.
-      !!
-      !! ** Method  : OASIS4
       !!----------------------------------------------------------------------
       !! * Arguments
       !!
-      INTEGER, INTENT( IN )  :: var_id    ! variable Id
-      INTEGER, INTENT( OUT ) :: info      ! variable Id
-      INTEGER, INTENT( IN )  :: date      ! ocean time-step in seconds
-      REAL(wp)               :: data_array(:,:)
-      !!
-      !! * Local declarations
-      !!
-#if defined key_mpp_mpi
-      REAL(wp)               :: global_array(jpiglo,jpjglo)
-      !
-!mpi  INTEGER                :: status(MPI_STATUS_SIZE)
-!mpi  INTEGER                :: type       ! MPI data type
-      INTEGER                :: request    ! MPI isend request
-      INTEGER                :: ji, jj, jn ! local loop indicees
-#else
-      INTEGER                :: ji
-#endif
-      !!
-      INTEGER, SAVE          :: ncount = 0
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument
+      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata
+      !!
       !!
       !!--------------------------------------------------------------------
-      !!
-      ncount = ncount + 1
-
-#if defined key_mpp_mpi
-
-      request = 0
-
-      IF ( rootexchg ) THEN
-         !
-!mpi     IF ( wp == 4 ) type = MPI_REAL
-!mpi     IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION
-         !
-         ! collect data on the local root process
-         !
-         IF ( localRank /= localRoot ) THEN
-
-            DO jj = nldj, nlej
-               DO ji = nldi, nlei
-                  exfld(ji-nldi+1,jj-nldj+1)=data_array(ji,jj)
-               ENDDO
-            ENDDO
-
-!mpi        CALL mpi_send(exfld, range(5), type, localRoot, localRank, localComm, ierror)
-            CALL mppsend (localRank, exfld, range(5), localRoot, request)
-         ENDIF
-
-         IF ( localRank == localRoot ) THEN
-
-            DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1
-               DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1
-                  global_array(ji,jj) = data_array(ji,jj) ! workaround
-               ENDDO
-            ENDDO
-
-            DO jn = 1, localSize-1
-
-!mpi           CALL mpi_recv(buffer, ranges(5,jn), type, localRoot, jn, localComm, status, ierror)
-               CALL mpprecv(jn, buffer, ranges(5,jn))
-
-               DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1
-                  DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1
-                     global_array(ji,jj) = buffer( (jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1 )
-                  ENDDO
-               ENDDO
-
-            ENDDO
-
-         ENDIF
-         !
-         ! send data from local root to OASIS4
-         !
-         CALL prism_put ( var_id, dates, dates_bound, global_array, info, ierror )      
-
-      ELSE
-         !
-         ! send local data from every process to OASIS4
-         !
-         CALL prism_put ( var_id, dates, dates_bound, data_array, info, ierror )      
-
-      ENDIF !rootexchg
-
-#else
-
-      !
-      ! send local data from every process to OASIS4
-      !
-      IF ( commRank ) &
-      CALL prism_put ( var_id, dates, dates_bound, data_array, info, ierror )      
-
-#endif
-
-      IF ( commRank ) THEN
-
-         IF (l_ctl) THEN
-
-            IF ( info==PRISM_Cpl ) THEN
-               WRITE(numout,*) '****************'
-               DO ji = 1, nsend
-                  IF (var_id == send_id(ji) ) THEN
-                     WRITE(numout,*) 'prism_put_proto: Outgoing ', cpl_send(ji)
-                     EXIT
-                  ENDIF
-               ENDDO
-               WRITE(numout,*) 'prism_put: var_id       ', var_id
-               WRITE(numout,*) 'prism_put:   date       ', date
-               WRITE(numout,*) 'prism_put:   info       ', info
-               WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-               WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-               WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
-               WRITE(numout,*) '****************'
-            ENDIF
-
-         ENDIF
-
-         IF ( ncount == nrecv ) THEN
-            !
-            !  3. Update dates and dates_bound for next step. We assume that cpl_prism_send
-            !  is called for all send fields at each time step. Therefore we update
-            !  the date argument to prism_put only every nsend call to cpl_prism_send.
-            !
-            dates_bound(1) = dates_bound(2)
-
-            tmpdate    = dates_bound(2)
-            date_incr  = rdCplttra(1)/2.0
-
-            CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-            dates = tmpdate
-            CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-            dates_bound(2) = tmpdate
-
-            ncount = 0
-
-         ENDIF
-
-      ENDIF ! commRank
-
-   END SUBROUTINE cpl_prism_send
-
-
-
-   SUBROUTINE cpl_prism_recv(  var_id, date, data_array, info )
-
-      IMPLICIT NONE
+      !
+      ! snd data to OASIS4
+      !
+      exfld(:,:,1) = pdata(nldi:nlei, nldj:nlej)
+      CALL prism_put( ssnd(kid)%nid, date, date_bound, exfld, kinfo, nerror )
+      IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(kid)%nid, 'cpl_prism_snd',   &
+         &                                               'Failure in prism_put for '//TRIM(ssnd(kid)%clname) )
+
+      IF ( ln_ctl ) THEN        
+         IF ( kinfo >= PRISM_Cpl     .OR. kinfo == PRISM_Rst .OR.   &
+            & kinfo == PRISM_RstTimeop ) THEN
+            WRITE(numout,*) '****************'
+            WRITE(numout,*) 'prism_put: Outgoing ', ssnd(kid)%clname
+            WRITE(numout,*) 'prism_put: ivarid ', ssnd(kid)%nid
+            WRITE(numout,*) 'prism_put:  kstep ', kstep
+            WRITE(numout,*) 'prism_put:   info ', kinfo
+            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
+            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
+            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
+            WRITE(numout,*) '****************'
+        ENDIF
+     ENDIF
+    END SUBROUTINE cpl_prism_snd
+
+
+   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
 
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_recv  ***
+      !!              ***  ROUTINE cpl_prism_rcv  ***
       !!
       !! ** Purpose : - At each coupling time-step,this routine receives fields
       !!      like stresses and fluxes from the coupler or remote application.
-      !!
-      !! ** Method  : OASIS4
       !!----------------------------------------------------------------------
-      !! * Arguments
-      !!
-      INTEGER, INTENT( IN )  :: var_id    ! variable Id
-      INTEGER, INTENT( OUT ) :: info      ! variable Id
-      INTEGER, INTENT( IN )  :: date      ! ocean time-step in seconds
-      REAL(wp),INTENT( OUT ) :: data_array(:,:)
-      !!
-      !! * Local declarations
-      !!
-#if defined key_mpp_mpi
-      REAL(wp)               :: global_array(jpiglo,jpjglo)
-      !
-      LOGICAL                :: action = .false.
-!mpi  INTEGER                :: status(MPI_STATUS_SIZE)
-!mpi  INTEGER                :: type       ! MPI data type
-      INTEGER                :: request    ! MPI isend request
-      INTEGER                :: ji, jj, jn ! local loop indicees
-#else
-      INTEGER                :: ji
-#endif
-
-      INTEGER, SAVE          :: ncount = 0
-      !!
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
+      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument
+      !!
+      LOGICAL                :: llaction
       !!--------------------------------------------------------------------
-      !!
-      ncount  = ncount + 1
-
-#ifdef key_mpp_mpi
-
-      request = 0
-
-      IF ( rootexchg ) THEN
-         !
-         ! receive data from OASIS4 on local root
-         !
-         IF ( commRank ) &
-         CALL prism_get (var_id, dater, dater_bound, global_array, info, ierror)
-         CALL MPI_BCAST ( info, 1, MPI_INTEGER, localRoot, localComm, ierror )
-
-      ELSE
-         !
-         ! receive local data from OASIS4 on every process
-         !
-         CALL prism_get (var_id, dater, dater_bound, exfld, info, ierror)
-
-      ENDIF
-
-      action = (info==PRISM_CplIO)
-
-      IF ( rootexchg .and. action ) THEN
-         !
-!mpi     IF ( wp == 4 ) type = MPI_REAL
-!mpi     IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION
-         !
-         ! distribute data to processes
-         !
-         IF ( localRank == localRoot ) THEN
-
-            DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1
-               DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1
-                  exfld(ji,jj) = global_array(ji,jj)
-               ENDDO
-            ENDDO
-
-            DO jn = 1, localSize-1
-
-               DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1
-                  DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1
-                     buffer( (jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1 ) = global_array(ji,jj)
-                  ENDDO
-               ENDDO
-
-!mpi           CALL mpi_send(buffer, ranges(5,jn), type, jn, jn, localComm, ierror)
-               CALL mppsend (jn, buffer, ranges(5,jn), jn, request)  
-
-            ENDDO
-
-         ENDIF
-
-         IF ( localRank /= localRoot ) &
-!mpi         CALL mpi_recv(exfld, range(5), type, localRoot, localRank, localComm, status, ierror)
-             CALL mpprecv(localRank, exfld, range(5))
-      ENDIF
-
-      IF ( action ) THEN
-
-         data_array = 0.0
-
-         DO jj = nldj, nlej
-            DO ji = nldi, nlei
-               data_array(ji,jj)=exfld(ji-nldi+1,jj-nldj+1)
-            ENDDO
-         ENDDO
-
-         IF (l_ctl) THEN        
+      !
+      ! receive local data from OASIS4 on every process
+      !
+      CALL prism_get( srcv(kid)%nid, date, date_bound, exfld, kinfo, nerror )         
+      IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(kid)%nid, 'cpl_prism_rcv',   &
+         &                                               'Failure in prism_get for '//TRIM(srcv(kid)%clname) )
+
+      WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
+      call flush(numout)
+      llaction = .false.
+      IF( kinfo == PRISM_Cpl )  llaction = .TRUE.
+
+      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid
+
+      IF ( llaction ) THEN
+
+         kinfo = OASIS_Rcv
+         pdata(nldi:nlei, nldj:nlej) = exfld(:,:,1)
+         
+         !--- Fill the overlap areas and extra hallows (mpp)
+         !--- check periodicity conditions (all cases)
+         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
+         
+         IF ( ln_ctl ) THEN        
             WRITE(numout,*) '****************'
-            DO ji = 1, nrecv
-               IF (var_id == recv_id(ji) ) THEN
-                  WRITE(numout,*) 'prism_get: Incoming ', cpl_recv(ji)
-                  EXIT
-               ENDIF
-            ENDDO
-            WRITE(numout,*) 'prism_get: var_id       ', var_id
-            WRITE(numout,*) 'prism_get:   date       ', date
-            WRITE(numout,*) 'prism_get:   info       ', info
-            WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-            WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-            WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
+            WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
+            WRITE(numout,*) 'prism_get: ivarid '  , srcv(kid)%nid
+            WRITE(numout,*) 'prism_get:   kstep', kstep
+            WRITE(numout,*) 'prism_get:   info ', kinfo
+            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
+            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
+            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
             WRITE(numout,*) '****************'
          ENDIF
 
+      ELSE
+         kinfo = OASIS_idle     
       ENDIF
-#else
-
-      CALL prism_get (var_id, dater, dater_bound, exfld, info, ierror)
-
-      IF ( info==PRISM_CplIO ) THEN
-               data_array=exfld
-
-         IF (l_ctl) THEN        
-            WRITE(numout,*) '****************'
-            DO ji = 1, nrecv
-               IF (var_id == recv_id(ji) ) THEN
-                  WRITE(numout,*) 'prism_get: Incoming ', cpl_recv(ji)
-                  EXIT
-               ENDIF
-            ENDDO
-            WRITE(numout,*) 'prism_get: var_id       ', var_id
-            WRITE(numout,*) 'prism_get:   date       ', date
-            WRITE(numout,*) 'prism_get:   info       ', info
-            WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-            WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-            WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
-            WRITE(numout,*) '****************'
-         ENDIF
-
-      ENDIF
-
-#endif
-
-      IF ( ncount == nrecv ) THEN
-         !
-         !  3. Update dater and dater_bound for next step. We assume that cpl_prism_recv
-         !  is called for all recv fields at each time step. Therefore we update
-         !  the date argument to prism_get only every nrecv call to cpl_prism_recv.
-         !
-         dater_bound(1) = dater_bound(2)
-
-         tmpdate    = dater_bound(2)
-         date_incr  = rdttra(1)/2.0
-
-         CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-         dater = tmpdate
-         CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-         dater_bound(2) = tmpdate
-
-         ncount = 0
-
-      ENDIF
-
-   END SUBROUTINE cpl_prism_recv
-
+
+
+   END SUBROUTINE cpl_prism_rcv
 
 
    SUBROUTINE cpl_prism_finalize
-
-      IMPLICIT NONE
 
       !!---------------------------------------------------------------------
@@ -1167 +431 @@
       !!      called explicitly before cpl_prism_init it will also close
       !!      MPI communication.
-      !!
-      !! ** Method  : OASIS4
       !!----------------------------------------------------------------------
 
       DEALLOCATE(exfld)
-
-      if ( prism_was_initialized ) then
-
-         call prism_terminated ( prism_was_terminated, ierror )
-         
-         if ( prism_was_terminated ) then
-            print *, 'prism has already been terminated.'
-         else
-            call prism_terminate ( ierror )
-            prism_was_terminated = .true.
-         endif
-
-      else
-
-         print *, 'Initialize prism before terminating it.'
-
-      endif
-
+      CALL prism_terminate ( nerror )         
 
    END SUBROUTINE cpl_prism_finalize
 
-#else
-
-   !!----------------------------------------------------------------------
-   !!   Default case           Dummy module         forced Ocean/Atmosphere
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE cpl_prism_init             ! Dummy routine
-   END SUBROUTINE cpl_prism_init
-   SUBROUTINE cpl_prism_define           ! Dummy routine
-   END SUBROUTINE cpl_prism_define
-   SUBROUTINE cpl_prism_send             ! Dummy routine
-   END SUBROUTINE cpl_prism_send
-   SUBROUTINE cpl_prism_recv             ! Dummy routine
-   END SUBROUTINE cpl_prism_recv
-   SUBROUTINE cpl_prism_finalize         ! Dummy routine
-   END SUBROUTINE cpl_prism_finalize
+   SUBROUTINE cpl_prism_update_time(kt)
+
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_update_time  ***
+      !!
+      !! ** Purpose : - Increment date with model timestep
+      !!      called explicitly at the end of each timestep
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
+
+      TYPE(PRISM_Time_struct)    :: tmpdate
+      INTEGER                    :: idate_incr     ! date increment
+
+
+      IF( kt == nit000 ) THEN
+      !
+      ! Define the actual date 
+      !
+      ! date is determined by adding days since beginning of the run to the corresponding initial date.
+      ! Note that OPA internal info about the start date of the experiment is bypassed.
+      ! Instead we rely sololy on the info provided by the SCC.xml file.
+      !
+         date = PRISM_Jobstart_date
+         !
+         !
+         ! lower/upper bound is determined by adding half a time step
+         !
+         idate_incr = 0.5 * NINT ( rdttra(1) )
+         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate, -idate_incr, nerror )   ;   date_bound(1) = tmpdate
+         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate,  idate_incr, nerror )   ;   date_bound(2) = tmpdate
+
+      ELSE
+      !
+      ! Date update
+      !
+         idate_incr  = rdttra(1)
+         CALL PRISM_calc_newdate( date, idate_incr, nerror )
+         date_bound(1) = date_bound(2)
+         tmpdate = date_bound(2)
+         CALL PRISM_calc_newdate( tmpdate, idate_incr, nerror )
+         date_bound(2) = tmpdate
+
+      END IF
+
+   END SUBROUTINE cpl_prism_update_time
 
 #endif

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

@@ -15 +15 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
+   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar
    USE phycst          ! ???
    USE in_out_manager  ! I/O manager
@@ -29 +30 @@
       LOGICAL              ::   ln_tint     ! time interpolation or not (T/F)
       LOGICAL              ::   ln_clim     ! climatology or not (T/F)
-      CHARACTER(len = 7)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
+      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
       CHARACTER(len = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not
       CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation
-                                           ! a string starting with "U" or "V" for each component   
-                                           ! chars 2 onwards identify which components go together  
+                                            ! a string starting with "U" or "V" for each component   
+                                            ! chars 2 onwards identify which components go together  
    END TYPE FLD_N
 
@@ -43 +44 @@
       LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F)
       LOGICAL                         ::   ln_clim      ! climatology or not (T/F)
-      CHARACTER(len = 7)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly'
+      CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly'
       INTEGER                         ::   num          ! iom id of the jpfld files to be read
-      INTEGER                         ::   nswap_sec    ! swapping time in second since Jan. 1st 00h of nit000 year
       INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year)
       INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year)
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:)   ::   fnow         ! input fields interpolated to now time step
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   fdta         ! 2 consecutive record of input fields
+      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow       ! input fields interpolated to now time step
+      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields
       CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key
                                                         ! into the WGTLIST structure
       CHARACTER(len = 34)             ::   vcomp        ! symbolic name for a vector component that needs rotation
-      LOGICAL ,  DIMENSION(2)         ::   rotn         ! flag to indicate whether field has been rotated
+      LOGICAL                         ::   rotn         ! flag to indicate whether field has been rotated
    END TYPE FLD
 
@@ -71 +71 @@
       INTEGER                                 ::   numwgt       ! number of weights (4=bilinear, 16=bicubic)
       INTEGER                                 ::   nestid       ! for agrif, keep track of nest we're in
-      INTEGER                                 ::   offset       ! =0 when cyclic grid has coincident first/last columns, 
-                                                                ! =1 when they assumed to be one grid spacing apart      
-                                                                ! =-1 otherwise
+      INTEGER                                 ::   overlap      ! =0 when cyclic grid has no overlapping EW columns
+                                                                ! =>1 when they have one or more overlapping columns      
+                                                                ! =-1 not cyclic
       LOGICAL                                 ::   cyclic       ! east-west cyclic or not
-      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpi     ! array of source integers
-      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers
+      INTEGER,  DIMENSION(:,:,:), POINTER     ::   data_jpi     ! array of source integers
+      INTEGER,  DIMENSION(:,:,:), POINTER     ::   data_jpj     ! array of source integers
       REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid
-      REAL(wp), DIMENSION(:,:), POINTER       ::   fly_dta      ! array of values on input grid
-      REAL(wp), DIMENSION(:,:), POINTER       ::   col2         ! temporary array for reading in columns
+      REAL(wp), DIMENSION(:,:,:), POINTER     ::   fly_dta      ! array of values on input grid
+      REAL(wp), DIMENSION(:,:,:), POINTER     ::   col          ! temporary array for reading in columns
    END TYPE WGT
 
@@ -91 +91 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -114 +114 @@
       TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
       !!
-      CHARACTER (LEN=34)                     ::   acomp     ! dummy weight name
-      INTEGER                                ::   kf, nf    ! dummy indices
-      INTEGER                                ::   imf       ! size of the structure sd
-      REAL(wp), DIMENSION(jpi,jpj)           ::   utmp, vtmp! temporary arrays for vector rotation
-
+      INTEGER  ::   imf        ! size of the structure sd
       INTEGER  ::   jf         ! dummy indices
-      INTEGER  ::   kw         ! index into wgts array
       INTEGER  ::   ireclast   ! last record to be read in the current year file
       INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend
@@ -131 +126 @@
       CHARACTER(LEN=1000) ::   clfmt   ! write format
       !!---------------------------------------------------------------------
-      !
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1))   ! middle of sbc time step
       imf = SIZE( sd )
-      isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1))   ! centrered in the middle of sbc time step
-      !
-      !                                         ! ===================== !
-      DO jf = 1, imf                            !    LOOP OVER FIELD    !
-         !                                      ! ===================== !
-         !
-         IF( kt == nit000 )   CALL fld_init( kn_fsbc, sd(jf) )
-         !
-         ! read/update the after data?
-         IF( isecsbc > sd(jf)%nswap_sec ) THEN 
-
-            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field
+      !
+      IF( kt == nit000 ) THEN                      ! initialization
+         DO jf = 1, imf 
+            CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped)
+         END DO
+         IF( lwp ) CALL wgt_print()                ! control print
+         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
+      ENDIF
+      !                                            ! ====================================== !
+      IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! update field at each kn_fsbc time-step !
+         !                                         ! ====================================== !
+         !
+         DO jf = 1, imf                            ! ---   loop over field   --- !
+            
+            IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000 ) THEN  ! read/update the after data?
+
+               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations
+                  sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)
 !CDIR COLLAPSE
-               sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2)
-               sd(jf)%rotn(1)     = sd(jf)%rotn(2)
+                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)
+               ENDIF
+
+               CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations
+
+               ! do we have to change the year/month/week/day of the forcing field?? 
+               IF( sd(jf)%ln_tint ) THEN
+                  ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current
+                  ! one. If so, we are still before the end of the year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1)
+                  ! will be larger than the record number that should be read for current year/month/week/day
+
+                  ! last record to be read in the current file
+                  IF    ( sd(jf)%nfreqh == -12 ) THEN                 ;   ireclast = 1    !  yearly mean
+                  ELSEIF( sd(jf)%nfreqh ==  -1 ) THEN                                     ! monthly mean
+                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 1
+                     ELSE                                             ;   ireclast = 12
+                     ENDIF
+                  ELSE                                                                    ! higher frequency mean (in hours)
+                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 
+                     ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN   ;   ireclast = 24 * 7                  / sd(jf)%nfreqh
+                     ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN   ;   ireclast = 24                      / sd(jf)%nfreqh
+                     ELSE                                             ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh 
+                     ENDIF
+                  ENDIF
+
+                  ! do we need next file data?
+                  IF( sd(jf)%nrec_a(1) > ireclast ) THEN
+
+                     sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file
+
+                     IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one.
+
+                        llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
+                        llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
+
+                        ! if the run finishes at the end of the current year/month/week/day, we will allow next
+                        ! year/month/week/day file to be not present. If the run continue further than the current
+                        ! year/month/week/day, next year/month/week/day file must exist
+                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run 
+                        llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year
+
+                        CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
+                           &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
+                           &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop )
+
+                        IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist
+                           CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     &
+                              &     ' not present -> back to current year/month/day')
+                           CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day
+                           sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file
+                        ENDIF
+
+                     ENDIF
+                  ENDIF
+
+               ELSE
+                  ! if we are not doing time interpolation, we must change the year/month/week/day of the file just after
+                  ! switching to the NEW year/month/week/day. If it is the case, we are at the beginning of the
+                  ! year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) = 1
+                  IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) )   &
+                     &   CALL fld_clopn( sd(jf), nyear, nmonth, nday )
+               ENDIF
+
+               ! read after data
+               CALL fld_get( sd(jf) )
+
             ENDIF
-
-            ! update record informations
-            CALL fld_rec( kn_fsbc, sd(jf) )
-
-            ! do we have to change the year/month/day of the forcing field?? 
-            IF( sd(jf)%ln_tint ) THEN
-               ! if we do time interpolation we will need to open next year/month/day file before the end of the current one
-               ! if so, we are still before the end of the year/month/day when calling fld_rec so sd(jf)%nrec_a(1) will be
-               ! larger than the record number that should be read for current year/month/day (for ex. 13 for monthly mean file)
-
-               ! last record to be read in the current file
-               IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12
-               ELSE                             
-                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 
-                  ELSEIF( sd(jf)%cltype == 'daily'     ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh
-                  ELSE                                         ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh 
-                  ENDIF
-               ENDIF
-              
-               ! do we need next file data?
-               IF( sd(jf)%nrec_a(1) > ireclast ) THEN
-
-                  sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file
-
-                  IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one.
-
-                     llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
-                     llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
-
-                     ! if the run finishes at the end of the current year/month/day, we will allow next year/month/day file to be
-                     ! not present. If the run continue further than the current year/month/day, next year/month/day file must exist
-                     isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run 
-                     llstop = isecend > sd(jf)%nswap_sec                                   ! read more than 1 record of next year
-
-                     CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
-                        &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
-                        &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop )
-
-                     IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist
-                        CALL ctl_warn('next year/month/day file: '//TRIM(sd(jf)%clname)//     &
-                                &     ' not present -> back to current year/month/day')
-                        CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day
-                        sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file
-                     ENDIF
-
-                  ENDIF 
-               ENDIF
-        
-            ELSE
-               ! if we are not doing time interpolation, we must change the year/month/day of the file just after switching
-               ! to the NEW year/month/day. If it is the case, we are at the beginning of the year/month/day when calling 
-               ! fld_rec so sd(jf)%nrec_a(1) = 1
-               IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. sd(jf)%ln_clim )   CALL fld_clopn( sd(jf), nyear, nmonth, nday )
-            ENDIF
-
-            ! read after data
-            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN
-               CALL wgt_list( sd(jf), kw )
-               CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) )
-            ELSE
-               CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) )
-            ENDIF
-            sd(jf)%rotn(2) = .FALSE.
-
-         ENDIF
-         !                                      ! ===================== !
-      END DO                                    !  END LOOP OVER FIELD  !
-      !                                         ! ===================== !
-
-      IF( kt == nit000 .AND. lwp ) CALL wgt_print()
-
-      !! Vector fields may need to be rotated onto the local grid direction
-      !! This has to happen before the time interpolations
-      !! (sga: following code should be modified so that pairs arent searched for each time
-
-      DO jf = 1, imf
-         !! find vector rotations required 
-         IF( LEN(TRIM(sd(jf)%vcomp)) > 0 ) THEN
-             !! east-west component has symbolic name starting with 'U'
-             IF( sd(jf)%vcomp(1:1) == 'U' ) THEN
-                !! found an east-west component, look for the north-south component
-                !! which has same symbolic name but with 'U' replaced with 'V'
-                nf = LEN_TRIM( sd(jf)%vcomp )
-                IF( nf == 1) THEN
-                   acomp = 'V'
-                ELSE
-                   acomp = 'V' // sd(jf)%vcomp(2:nf)
-                ENDIF
-                kf = -1
-                DO nf = 1, imf
-                  IF( TRIM(sd(nf)%vcomp) == TRIM(acomp) ) kf = nf
-                END DO
-                IF( kf > 0 ) THEN
-                   !! fields jf,kf are two components which need to be rotated together
-                   DO nf = 1,2
-                      !! check each time level of this pair
-                      IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN
-                         utmp(:,:) = 0.0
-                         vtmp(:,:) = 0.0
-                         CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) )
-                         CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) )
-                         sd(jf)%fdta(:,:,nf) = utmp(:,:)
-                         sd(kf)%fdta(:,:,nf) = vtmp(:,:)
-                         sd(jf)%rotn(nf) = .TRUE.
-                         sd(kf)%rotn(nf) = .TRUE.
-                         IF( lwp .AND. kt == nit000 ) &
-                                   WRITE(numout,*) 'fld_read: vector pair (',  &
-                                                   TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), &
-                                                   ') rotated on to model grid'
-                      ENDIF
-                   END DO
-                ENDIF
-             ENDIF
-         ENDIF
-      END DO
-
-      !                                         ! ===================== !
-      DO jf = 1, imf                            !    LOOP OVER FIELD    !
-         !                                      ! ===================== !
-         !
-         ! update field at each kn_fsbc time-step
-         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN   
+         END DO                                    ! --- end loop over field --- !
+
+         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
+
+         DO jf = 1, imf                            ! ---   loop over field   --- !
             !
-            IF( sd(jf)%ln_tint ) THEN
+            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation
                IF(lwp .AND. kt - nit000 <= 100 ) THEN 
-                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
-                     &    "' records b/a: ', i4.4, '/', i4.4, ' (', f7.2,'/', f7.2, ' days)')"
-                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, nyear, nmonth, nday,   &
+                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
+                     &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')"
+                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &
                      & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
                ENDIF
-               !
+               ! temporal interpolation weights
                ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp )
                ztintb =  1. - ztinta
 !CDIR COLLAPSE
-               sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2)
-            ELSE
+               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2)
+            ELSE   ! nothing to do...
                IF(lwp .AND. kt - nit000 <= 100 ) THEN
-                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
-                     &    "' record: ', i4.4, ' at ', f7.2, ' day')"
-                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, nyear, nmonth, nday, sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_a(2),wp)/rday
+                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
+                     &    "', record: ', i4.4, ' (days ', f7.2, ' <-> ', f7.2, ')')"
+                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,    &
+                     &                 sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
                ENDIF
-!CDIR COLLAPSE
-               sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field
- 
             ENDIF
             !
-         ENDIF
-
-         IF( kt == nitend )   CALL iom_close( sd(jf)%num )   ! Close the input files
-
-         !                                      ! ===================== !
-      END DO                                    !  END LOOP OVER FIELD  !
-      !                                         ! ===================== !
+            IF( kt == nitend - kn_fsbc + 1 )   CALL iom_close( sd(jf)%num )   ! Close the input files
+
+         END DO                                    ! --- end loop over field --- !
+         !
+         !                                         ! ====================================== !
+      ENDIF                                        ! update field at each kn_fsbc time-step !
+      !                                            ! ====================================== !
+      !
    END SUBROUTINE fld_read
 
@@ -314 +262 @@
       !! ** Method  :   
       !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   ) ::   kn_fsbc     ! sbc computation period (in time step) 
-      TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables
-      !!
-      LOGICAL :: llprevyr       ! are we reading previous year  file?
-      LOGICAL :: llprevmth      ! are we reading previous month file?
-      LOGICAL :: llprevday      ! are we reading previous day   file?
-      LOGICAL :: llprev         ! llprevyr .OR. llprevmth .OR. llprevday
-      INTEGER :: idvar          ! variable id 
-      INTEGER :: inrec          ! number of record existing for this variable
-      INTEGER :: kwgt
+      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step) 
+      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables
+      !!
+      LOGICAL :: llprevyr              ! are we reading previous year  file?
+      LOGICAL :: llprevmth             ! are we reading previous month file?
+      LOGICAL :: llprevweek            ! are we reading previous week  file?
+      LOGICAL :: llprevday             ! are we reading previous day   file?
+      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
+      INTEGER :: idvar                 ! variable id 
+      INTEGER :: inrec                 ! number of record existing for this variable
+      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
+      INTEGER :: isec_week             ! number of seconds since start of the weekly file
       CHARACTER(LEN=1000) ::   clfmt   ! write format
       !!---------------------------------------------------------------------
-
+      
       ! some default definitions...
       sdjf%num = 0   ! default definition for non-opened file
       IF( sdjf%ln_clim )   sdjf%clname = TRIM( sdjf%clrootname )   ! file name defaut definition, never change in this case
-      llprevyr  = .FALSE.
-      llprevmth = .FALSE.
-      llprevday = .FALSE.
+      llprevyr   = .FALSE.
+      llprevmth  = .FALSE.
+      llprevweek = .FALSE.
+      llprevday  = .FALSE.
+      isec_week  = 0
             
+      IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy == 0 )   &
+         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs nn_leapy = 1')
+      IF( sdjf%cltype(1:4) == 'week' .AND. sdjf%ln_clim  )   &
+         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs ln_clim = .FALSE.')
+
       ! define record informations
-      CALL fld_rec( kn_fsbc, sdjf )
-
-      ! Note: shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later)
+
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
 
       IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure
-         
-         IF( sdjf%nrec_b(1) == 0  ) THEN   ! we redefine record sdjf%nrec_b(1) with the last record of previous year file
-            IF( sdjf%nfreqh == -1 ) THEN   ! monthly mean
-               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file
-                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record
-                  llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file?
+
+         IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file
+            IF    ( sdjf%nfreqh == -12 ) THEN   ! yearly mean
+               IF( sdjf%cltype == 'yearly' ) THEN             ! yearly file
+                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
+                  llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file?
+               ELSE
+                  CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clname) )
+               ENDIF
+            ELSEIF( sdjf%nfreqh ==  -1 ) THEN   ! monthly mean
+               IF( sdjf%cltype == 'monthly' ) THEN            ! monthly file
+                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
+                  llprevmth = .TRUE.                                                       ! use previous month file?
                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSE                                  ! yearly file
-                  sdjf%nrec_b(1) = 12                                                      ! force to read december mean
+               ELSE                                           ! yearly file
+                  sdjf%nrec_a(1) = 12                                                      ! force to read december mean
                   llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
                ENDIF
-            ELSE   
-               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file
-                  sdjf%nrec_b(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh                 ! last record of previous month
-                  llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file?
+            ELSE                                ! higher frequency mean (in hours) 
+               IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file
+                  sdjf%nrec_a(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh                 ! last record of previous month
+                  llprevmth = .TRUE.                                                       ! use previous month file?
                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file
-                  sdjf%nrec_b(1) = 24 / sdjf%nfreqh                                        ! last record of previous day
-                  llprevday = .NOT. sdjf%ln_clim                                           ! use previous day   file?
+               ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ! weekly file
+                  llprevweek = .TRUE.                                                      ! use previous week  file?
+                  sdjf%nrec_a(1) = 24 * 7 / sdjf%nfreqh                                    ! last record of previous week
+                  isec_week = NINT(rday) * 7                                               ! add a shift toward previous week
+               ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file
+                  sdjf%nrec_a(1) = 24 / sdjf%nfreqh                                        ! last record of previous day
+                  llprevday = .TRUE.                                                       ! use previous day   file?
                   llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file?
                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSE                                  ! yearly file
-                  sdjf%nrec_b(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of year month
+               ELSE                                           ! yearly file
+                  sdjf%nrec_a(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of previous year 
                   llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
                ENDIF
             ENDIF
          ENDIF
-         llprev = llprevyr .OR. llprevmth .OR. llprevday
-
-         CALL fld_clopn( sdjf, nyear  - COUNT((/llprevyr /))                                              ,               &
-            &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               &
-            &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev )
-         
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week
+            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month
+            llprevyr  = llprevmth .AND. nmonth == 1
+         ENDIF
+         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
+         !
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
+         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
+         !
+         CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev )
+
          ! if previous year/month/day file does not exist, we switch to the current year/month/day
          IF( llprev .AND. sdjf%num <= 0 ) THEN
-            CALL ctl_warn( 'previous year/month/day file: '//TRIM(sdjf%clname)//' not present -> back to current year/month/day')
+            CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clname)//   &
+               &           ' not present -> back to current year/month/week/day' )
             ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day
-            llprev = .false.
-            sdjf%nrec_b(1) = 1
+            llprev = .FALSE.
+            sdjf%nrec_a(1) = 1
             CALL fld_clopn( sdjf, nyear, nmonth, nday )
          ENDIF
@@ -386 +362 @@
             IF( idvar <= 0 )   RETURN
             inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar )   ! size of the last dim of idvar
-            sdjf%nrec_b(1) = MIN( sdjf%nrec_b(1), inrec )   ! make sure we select an existing record
-         ENDIF
-
-         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read
-         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
-            CALL wgt_list( sdjf, kwgt )
-            CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) )
+            sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record
+         ENDIF
+
+         ! read before data 
+         CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later)
+
+         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')"
+         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
+
+         IF( llprev )   CALL iom_close( sdjf%num )          ! force to close previous year file (-> redefine sdjf%num to 0)
+
+      ENDIF
+
+      ! make sure current year/month/day file is opened
+      IF( sdjf%num <= 0 ) THEN
+         !
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week
+            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
+            llprevyr   = llprevmth .AND. nmonth == 1
          ELSE
-            CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) )
-         ENDIF
-         sdjf%rotn(2) = .FALSE.
-
-         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')"
-         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_b(1), REAL(sdjf%nrec_b(2),wp)/rday
-
-         IF( llprev )   CALL iom_close( sdjf%num )   ! close previous year file (-> redefine sdjf%num to 0)
-
+            isec_week  = 0
+            llprevmth  = .FALSE.
+            llprevyr   = .FALSE.
+         ENDIF
+         !
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
+         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
+         !
+         CALL fld_clopn( sdjf, iyear, imonth, iday )
+      ENDIF 
+
+   END SUBROUTINE fld_init
+
+
+   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_rec  ***
+      !!
+      !! ** Purpose : Compute
+      !!              if sdjf%ln_tint = .TRUE.
+      !!                  nrec_a: record number and its time (nrec_b is obtained from nrec_a when swapping)
+      !!              if sdjf%ln_tint = .FALSE.
+      !!                  nrec_a(1): record number
+      !!                  nrec_b(2) and nrec_a(2): time of the beginning and end of the record (for print only)
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   )           ::   kn_fsbc   ! sbc computation period (in time step) 
+      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables
+      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.)
+                                                        ! used only if sdjf%ln_tint = .TRUE.
+      !!
+      LOGICAL  ::   llbefore    ! local definition of ldbefore
+      INTEGER  ::   iendrec     ! end of this record (in seconds)
+      INTEGER  ::   imth        ! month number
+      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
+      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file
+      REAL(wp) ::   ztmp        ! temporary variable
+      !!----------------------------------------------------------------------
+      !
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      !
+      IF( PRESENT(ldbefore) ) THEN   ;   llbefore = ldbefore .AND. sdjf%ln_tint   ! needed only if sdjf%ln_tint = .TRUE.
+      ELSE                           ;   llbefore = .FALSE.
       ENDIF
-
-      IF( sdjf%num <= 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened
-
-      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read 
-      
-   END SUBROUTINE fld_init
-
-
-   SUBROUTINE fld_rec( kn_fsbc, sdjf )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE fld_rec  ***
-      !!
-      !! ** Purpose :   compute nrec_a, nrec_b and nswap_sec
-      !!
-      !! ** Method  :   
-      !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   ) ::   kn_fsbc     ! sbc computation period (in time step) 
-      TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables
-      !!
-      INTEGER  ::   irec        ! record number
-      INTEGER  ::   isecd       ! rday
-      REAL(wp) ::   ztmp        ! temporary variable
-      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
-      !!----------------------------------------------------------------------
-      !
-      ! Note: shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-      !
-      IF( sdjf%nfreqh == -1 ) THEN      ! monthly mean
+      !
+      !                                      ! =========== !
+      IF    ( sdjf%nfreqh == -12 ) THEN      ! yearly mean
+         !                                   ! =========== !
+         !
+         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
+            !
+            !                  INT( ztmp )
+            !                     /|\
+            !                    1 |    *----
+            !                    0 |----(              
+            !                      |----+----|--> time
+            !                      0   /|\   1   (nday/nyear_len(1))
+            !                           |   
+            !                           |   
+            !       forcing record :    1 
+            !                            
+            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5
+            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
+            ! swap at the middle of the year
+            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0)
+            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)   
+            ENDIF
+         ELSE                                    ! no time interpolation
+            sdjf%nrec_a(1) = 1
+            sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000   ! swap at the end    of the year
+            sdjf%nrec_b(2) = nsec1jan000                               ! beginning of the year (only for print)
+         ENDIF
+         !
+         !                                   ! ============ !
+      ELSEIF( sdjf%nfreqh ==  -1 ) THEN      ! monthly mean !
+         !                                   ! ============ !
          !
          IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
@@ -445 +474 @@
             !       forcing record :  nmonth 
             !                            
-            ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5
-         ELSE
-            ztmp  = 0.e0
-         ENDIF
-         irec = nmonth + INT( ztmp )
-
-         IF( sdjf%ln_tint ) THEN   ;   sdjf%nswap_sec = nmonth_half(irec) + nsec1jan000   ! swap at the middle of the month
-         ELSE                      ;   sdjf%nswap_sec = nmonth_end (irec) + nsec1jan000   ! swap at the end    of the month
-         ENDIF
-
-         sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time
-         irec = irec - 1                                                ! move back to previous record
-         sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time
-         !
-      ELSE                              ! higher frequency mean (in hours)
-         !
-         ifreq_sec = sdjf%nfreqh * 3600   ! frequency mean (in seconds)
+            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5
+            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
+            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
+            ELSE                                  ;   sdjf%nrec_a(1) = imth
+            ENDIF
+            sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month
+         ELSE                                    ! no time interpolation
+            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1
+            ELSE                                  ;   sdjf%nrec_a(1) = nmonth
+            ENDIF
+            sdjf%nrec_a(2) =  nmonth_end(nmonth  ) + nsec1jan000   ! swap at the end    of the month
+            sdjf%nrec_b(2) =  nmonth_end(nmonth-1) + nsec1jan000   ! beginning of the month (only for print)
+         ENDIF
+         !
+         !                                   ! ================================ !
+      ELSE                                   ! higher frequency mean (in hours)
+         !                                   ! ================================ !
+         !
+         ifreq_sec = sdjf%nfreqh * 3600                                                 ! frequency mean (in seconds)
+         IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week
          ! number of second since the beginning of the file
-         IF(     sdjf%cltype == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)   ! since 00h on the 1st day of the current month
-         ELSEIF( sdjf%cltype == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)   ! since 00h of the current day
-         ELSE                                      ;   ztmp = REAL(nsec_year ,wp)   ! since 00h on Jan 1 of the current year
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)  ! since the first day of the current month
+         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week ,wp)  ! since the first day of the current week
+         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)  ! since 00h of the current day
+         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year
          ENDIF
          ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step
@@ -482 +515 @@
             !       forcing record :  1     2     3
             !                   
-            ztmp = ztmp / REAL(ifreq_sec, wp) + 0.5
-         ELSE                 
+            ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5
+         ELSE                                   ! no time interpolation
             !
             !                  INT( ztmp )
@@ -496 +529 @@
             !       forcing record :  1     2     3
             !                            
-            ztmp = ztmp / REAL(ifreq_sec, wp)
-         ENDIF
-         irec = 1 + INT( ztmp )
-
-         isecd = NINT(rday)
-         ! after record index and second since Jan. 1st 00h of nit000 year
-         sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /)
-         IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month
-            sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1
-         IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day
-            sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 )
-
-         ! before record index and second since Jan. 1st 00h of nit000 year
-         irec = irec - 1.                           ! move back to previous record
-         sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /)
-         IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month
-            sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1
-         IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day
-            sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 )
-
-         ! swapping time in second since Jan. 1st 00h of nit000 year
-         IF( sdjf%ln_tint ) THEN   ;   sdjf%nswap_sec =  sdjf%nrec_a(2)                     ! swap at the middle of the record
-         ELSE                      ;   sdjf%nswap_sec =  sdjf%nrec_a(2) + ifreq_sec / 2     ! swap at the end    of the record
-         ENDIF       
+            ztmp= ztmp / REAL(ifreq_sec, wp)
+         ENDIF
+         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record nomber to be read
+
+         iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second)
+         ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1)
+         IF( sdjf%cltype      == 'monthly' )   iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1))
+         IF( sdjf%cltype(1:4) == 'week'    )   iendrec = iendrec + ( nsec_year - isec_week )
+         IF( sdjf%cltype      == 'daily'   )   iendrec = iendrec + NINT(rday) * ( nday_year - 1 )
+         IF( sdjf%ln_tint ) THEN
+             sdjf%nrec_a(2) = iendrec - ifreq_sec / 2        ! swap at the middle of the record
+         ELSE
+             sdjf%nrec_a(2) = iendrec                        ! swap at the end    of the record
+             sdjf%nrec_b(2) = iendrec - ifreq_sec            ! beginning of the record (only for print)
+         ENDIF
          !
       ENDIF
@@ -526 +550 @@
 
 
+   SUBROUTINE fld_get( sdjf )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_clopn  ***
+      !!
+      !! ** Purpose :   read the data
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      TYPE(FLD), INTENT(inout)   ::   sdjf   ! input field related variables
+      !!
+      INTEGER                    ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER                    ::   iw     ! index into wgts array
+      !!---------------------------------------------------------------------
+            
+      ipk = SIZE( sdjf%fnow, 3 )
+      IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
+         CALL wgt_list( sdjf, iw )
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
+         ENDIF
+      ELSE
+         SELECT CASE( ipk )
+         CASE(1)   
+            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) )
+            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) )
+            ENDIF
+         CASE DEFAULT
+            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
+            ENDIF
+         END SELECT
+      ENDIF
+      !
+      sdjf%rotn = .false.   ! vector not yet rotated
+
+   END SUBROUTINE fld_get
+
+
+   SUBROUTINE fld_rot( kt, sd )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_clopn  ***
+      !!
+      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step
+      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
+      !!
+      INTEGER                      ::   ju, jv, jk   ! loop indices
+      INTEGER                      ::   imf          ! size of the structure sd
+      INTEGER                      ::   ill          ! character length
+      INTEGER                      ::   iv           ! indice of V component
+      REAL(wp), DIMENSION(jpi,jpj) ::   utmp, vtmp   ! temporary arrays for vector rotation
+      CHARACTER (LEN=100)          ::   clcomp       ! dummy weight name
+      !!---------------------------------------------------------------------
+      !! (sga: following code should be modified so that pairs arent searched for each time
+      !
+      imf = SIZE( sd )
+      DO ju = 1, imf
+         ill = LEN_TRIM( sd(ju)%vcomp )
+         IF( ill > 0 .AND. .NOT. sd(ju)%rotn ) THEN   ! find vector rotations required             
+             IF( sd(ju)%vcomp(1:1) == 'U' ) THEN      ! east-west component has symbolic name starting with 'U'
+                ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V'
+                clcomp = 'V' // sd(ju)%vcomp(2:ill)   ! works even if ill == 1
+                iv = -1
+                DO jv = 1, imf
+                  IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) )   iv = jv
+                END DO
+                IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together
+                   DO jk = 1, SIZE( sd(ju)%fnow, 3 )
+                      IF( sd(ju)%ln_tint )THEN
+                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->i', utmp(:,:) )
+                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->j', vtmp(:,:) )
+                         sd(ju)%fdta(:,:,jk,2) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,2) = vtmp(:,:)
+                      ELSE 
+                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) )
+                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) )
+                         sd(ju)%fnow(:,:,jk  ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk  ) = vtmp(:,:)
+                      ENDIF
+                   END DO
+                   sd(ju)%rotn = .TRUE.               ! vector was rotated 
+                   IF( lwp .AND. kt == nit000 )   WRITE(numout,*)   &
+                      &   'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid'
+                ENDIF
+             ENDIF
+          ENDIF
+       END DO
+   END SUBROUTINE fld_rot
+
+
    SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop )
       !!---------------------------------------------------------------------
@@ -534 +649 @@
       !! ** Method  :   
       !!----------------------------------------------------------------------
-      TYPE(FLD), INTENT(inout)           ::   sdjf     ! input field related variables
-      INTEGER  , INTENT(in   )           ::   kyear    ! year value
-      INTEGER  , INTENT(in   )           ::   kmonth   ! month value
-      INTEGER  , INTENT(in   )           ::   kday     ! day value
-      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      TYPE(FLD), INTENT(inout)           ::   sdjf                  ! input field related variables
+      INTEGER  , INTENT(in   )           ::   kyear                 ! year value
+      INTEGER  , INTENT(in   )           ::   kmonth                ! month value
+      INTEGER  , INTENT(in   )           ::   kday                  ! day value
+      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop                ! stop if open to read a non-existing file (default = .TRUE.)
 
       IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
       ! build the new filename if not climatological data
-      IF( .NOT. sdjf%ln_clim ) THEN   ;   WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
-         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month
-         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day
+      sdjf%clname=TRIM(sdjf%clrootname)
+      !
+      ! note that sdjf%ln_clim is is only acting on presence of the year in the file
+      IF( .NOT. sdjf%ln_clim ) THEN   
+                                         WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
+         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month
+      ELSE
+         ! build the new filename if climatological data
+         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month
       ENDIF
+      IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
+            &                            WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day
+      !
       CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
       !
@@ -575 +699 @@
          sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint
          sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim
-         IF( sdf(jf)%nfreqh == -1. ) THEN   ;   sdf(jf)%cltype = 'yearly'
-         ELSE                               ;   sdf(jf)%cltype = sdf_n(jf)%cltype
-         ENDIF
+         sdf(jf)%cltype     = sdf_n(jf)%cltype
          sdf(jf)%wgtname = " "
          IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname )
@@ -598 +720 @@
                &                          ' pairing    : '    , TRIM( sdf(jf)%vcomp      ),   &
                &                          ' data type: '      ,       sdf(jf)%cltype
+            call flush(numout)
          END DO
       ENDIF
@@ -672 +795 @@
          IF( ref_wgts(kw)%cyclic ) THEN
             WRITE(numout,*) '       cyclical'
-            IF( ref_wgts(kw)%offset > 0 ) WRITE(numout,*) '                 with offset'
+            IF( ref_wgts(kw)%overlap > 0 ) WRITE(numout,*) '              with overlap of ', ref_wgts(kw)%overlap
          ELSE
             WRITE(numout,*) '       not cyclical'
@@ -695 +818 @@
       INTEGER                                 ::   inum          ! temporary logical unit
       INTEGER                                 ::   id            ! temporary variable id
+      INTEGER                                 ::   ipk           ! temporary vertical dimension
       CHARACTER (len=5)                       ::   aname
       INTEGER , DIMENSION(3)                  ::   ddims
       INTEGER , DIMENSION(jpi, jpj)           ::   data_src
       REAL(wp), DIMENSION(jpi, jpj)           ::   data_tmp
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::   line2, lines  ! temporary array to read 2 lineumns
-      CHARACTER (len=34)                      ::   lonvar
       LOGICAL                                 ::   cyclical
-      REAL(wp)                                ::   resid, dlon   ! temporary array to read 2 lineumns
-      INTEGER                                 ::   offset        ! temporary integer
+      INTEGER                                 ::   zwrap         ! temporary integer
       !!----------------------------------------------------------------------
       !
@@ -721 +842 @@
       id = iom_varid( inum, sd%clvar, ddims )
 
-      !! check for an east-west cyclic grid
-      !! try to guess name of longitude variable
-
-      lonvar = 'nav_lon'
-      id = iom_varid(inum, TRIM(lonvar), ldstop=.FALSE.)
-      IF( id <= 0 ) THEN
-         lonvar = 'lon'
-         id = iom_varid(inum, TRIM(lonvar), ldstop=.FALSE.)
-      ENDIF
-
-      offset = -1
-      cyclical = .FALSE.
-      IF( id > 0 ) THEN
-         !! found a longitude variable
-         !! now going to assume that grid is regular so we can read a single row
-
-         !! because input array is 2d, have to present iom with 2d array even though we only need 1d slice
-         !! worse, we cant pass line2(:,1) to iom_get since this is treated as a 1d array which doesnt match input file
-         ALLOCATE( lines(ddims(1),2) )
-         CALL iom_get(inum, jpdom_unknown, lonvar, lines(:,:), 1, kstart=(/1,1/), kcount=(/ddims(1),2/) )
-
-         !! find largest grid spacing
-         lines(1:ddims(1)-1,2) = lines(2:ddims(1),1) - lines(1:ddims(1)-1,1)
-         dlon = MAXVAL( lines(1:ddims(1)-1,2) )
-
-         resid = ABS(ABS(lines(ddims(1),1)-lines(1,1))-360.0)
-         IF( resid < rsmall ) THEN
-            !! end rows overlap in longitude
-            offset = 0
-            cyclical = .TRUE.
-         ELSEIF( resid < 2.0*dlon ) THEN
-            !! also call it cyclic if difference between end points is less than twice dlon from 360
-            offset = 1
-            cyclical = .TRUE.
-         ENDIF
-
-         DEALLOCATE( lines )
-
-      ELSE
-         !! guessing failed
-         !! read in first and last columns of data variable
-         !! since we dont know the name of the longitude variable (or even if there is one)
-         !! we assume that if these two columns are equal, file is cyclic east-west
-
-         !! because input array is 2d, have to present iom with 2d array even though we only need 1d slice
-         !! worse, we cant pass line2(1,:) to iom_get since this is treated as a 1d array which doesnt match input file
-         ALLOCATE( lines(2,ddims(2)), line2(2,ddims(2)) )
-         CALL iom_get(inum, jpdom_unknown, sd%clvar, line2(:,:), 1, kstart=(/1,1/), kcount=(/2,ddims(2)/) )
-         lines(2,:) = line2(1,:)
-
-         CALL iom_get(inum, jpdom_unknown, sd%clvar, line2(:,:), 1, kstart=(/ddims(1)-1,1/), kcount=(/2,ddims(2)/) )
-         lines(1,:) = line2(2,:)
-
-         resid = SUM( ABS(lines(1,:) - lines(2,:)) )
-         IF( resid < ddims(2)*rsmall ) THEN
-            offset = 0
-            cyclical = .TRUE.
-         ENDIF
-
-         DEALLOCATE( lines, line2 )
-      ENDIF
-
       !! close it
       CALL iom_close( inum )
@@ -790 +849 @@
       CALL iom_open ( sd%wgtname, inum )   ! interpolation weights
       IF ( inum > 0 ) THEN
+
+         !! determine whether we have an east-west cyclic grid
+         !! from global attribute called "ew_wrap" in the weights file
+         !! note that if not found, iom_getatt returns -999 and cyclic with no overlap is assumed
+         !! since this is the most common forcing configuration
+
+         CALL iom_getatt(inum, 'ew_wrap', zwrap)
+         IF( zwrap >= 0 ) THEN
+            cyclical = .TRUE.
+         ELSE IF( zwrap == -999 ) THEN
+            cyclical = .TRUE.
+            zwrap = 0
+         ELSE
+            cyclical = .FALSE.
+         ENDIF
 
          ref_wgts(nxt_wgt)%ddims(1) = ddims(1)
          ref_wgts(nxt_wgt)%ddims(2) = ddims(2)
          ref_wgts(nxt_wgt)%wgtname = sd%wgtname
-         ref_wgts(nxt_wgt)%offset = -1
-         ref_wgts(nxt_wgt)%cyclic = .FALSE.
-         IF( cyclical ) THEN
-            ref_wgts(nxt_wgt)%offset = offset
-            ref_wgts(nxt_wgt)%cyclic = .TRUE.
-         ENDIF
+         ref_wgts(nxt_wgt)%overlap = zwrap
+         ref_wgts(nxt_wgt)%cyclic = cyclical
          ref_wgts(nxt_wgt)%nestid = 0
 #if defined key_agrif
@@ -857 +927 @@
          ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration. 
          ! a more robust solution will be given in next release
-         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) )
-         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) )
+         ipk =  SIZE(sd%fnow, 3)
+         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) )
+         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col(1,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) )
 
          nxt_wgt = nxt_wgt + 1
@@ -868 +939 @@
    END SUBROUTINE fld_weight
 
-   SUBROUTINE fld_interp(num, clvar, kw, dta, nrec)
+   SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_interp  ***
@@ -880 +951 @@
       CHARACTER(LEN=*), INTENT(in)                        ::   clvar               ! variable name
       INTEGER,          INTENT(in)                        ::   kw                  ! weights number
-      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj) ::   dta                 ! output field on model grid
+      INTEGER,          INTENT(in)                        ::   kk                  ! vertical dimension of kk
+      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta              ! output field on model grid
       INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice)
       !! 
-      INTEGER, DIMENSION(2)                               ::   rec1,recn           ! temporary arrays for start and length
+      INTEGER, DIMENSION(3)                               ::   rec1,recn           ! temporary arrays for start and length
       INTEGER                                             ::  jk, jn, jm           ! loop counters
       INTEGER                                             ::  ni, nj               ! lengths
@@ -897 +969 @@
       !! so we need to have a 4 by 4 subgrid surrounding each model point to cover both cases
 
-      !! sub grid where we already have weights
+      !! sub grid from non-model input grid which encloses all grid points in this nemo process
       jpimin = ref_wgts(kw)%botleft(1)
       jpjmin = ref_wgts(kw)%botleft(2)
@@ -903 +975 @@
       jpjwid = ref_wgts(kw)%jpjwgt
 
-      !! what we need to read into sub grid in order to calculate gradients
+      !! when reading in, expand this sub-grid by one halo point all the way round for calculating gradients
       rec1(1) = MAX( jpimin-1, 1 )
       rec1(2) = MAX( jpjmin-1, 1 )
+      rec1(3) = 1
       recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 )
       recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 )
-
-      !! where we need to read it to
+      recn(3) = kk
+
+      !! where we need to put it in the non-nemo grid fly_dta
+      !! note that jpi1 and jpj1 only differ from 1 when jpimin and jpjmin are 1
+      !! (ie at the extreme west or south of the whole input grid) and similarly for jpi2 and jpj2
       jpi1 = 2 + rec1(1) - jpimin
       jpj1 = 2 + rec1(2) - jpjmin
@@ -915 +991 @@
       jpj2 = jpj1 + recn(2) - 1
 
-      ref_wgts(kw)%fly_dta(:,:) = 0.0
-      CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn)
+      ref_wgts(kw)%fly_dta(:,:,:) = 0.0
+      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
+      CASE(1)
+           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
+      CASE DEFAULT
+           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
+      END SELECT 
 
       !! first four weights common to both bilinear and bicubic
+      !! data_jpi, data_jpj have already been shifted to (1,1) corresponding to botleft
       !! note that we have to offset by 1 into fly_dta array because of halo
-      dta(:,:) = 0.0
+      dta(:,:,:) = 0.0
       DO jk = 1,4
         DO jn = 1, jpj
@@ -926 +1008 @@
             ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
             nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-            dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1)
+            dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,:)
           END DO
         END DO
@@ -935 +1017 @@
         !! fix up halo points that we couldnt read from file
         IF( jpi1 == 2 ) THEN
-           ref_wgts(kw)%fly_dta(jpi1-1,:) = ref_wgts(kw)%fly_dta(jpi1,:)
+           ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:)
         ENDIF
         IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
-           ref_wgts(kw)%fly_dta(jpi2+1,:) = ref_wgts(kw)%fly_dta(jpi2,:)
+           ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:)
         ENDIF
         IF( jpj1 == 2 ) THEN
-           ref_wgts(kw)%fly_dta(:,jpj1-1) = ref_wgts(kw)%fly_dta(:,jpj1)
+           ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:)
         ENDIF
         IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN
-           ref_wgts(kw)%fly_dta(:,jpj2+1) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1)
+           ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:)
         ENDIF
 
@@ -951 +1033 @@
         IF( ref_wgts(kw)%cyclic ) THEN
            rec1(2) = MAX( jpjmin-1, 1 )
-           recn(1) = 2
+           recn(1) = 1
            recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 )
            jpj1 = 2 + rec1(2) - jpjmin
            jpj2 = jpj1 + recn(2) - 1
            IF( jpi1 == 2 ) THEN
-              rec1(1) = ref_wgts(kw)%ddims(1) - 1
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn)
-              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2)
+              rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap
+              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
+              CASE(1)
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
+              CASE DEFAULT
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
+              END SELECT      
+              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
-              rec1(1) = 1
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn)
-              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2)
+              rec1(1) = 1 + ref_wgts(kw)%overlap
+              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
+              CASE(1)
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
+              CASE DEFAULT
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
+              END SELECT
+              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
         ENDIF
@@ -973 +1065 @@
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj+1) - ref_wgts(kw)%fly_dta(ni,nj+1))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:))
             END DO
           END DO
@@ -985 +1077 @@
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         &
-                               (ref_wgts(kw)%fly_dta(ni+1,nj+2) - ref_wgts(kw)%fly_dta(ni+1,nj))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         &
+                               (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:))
             END DO
           END DO
@@ -997 +1089 @@
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj+2) - ref_wgts(kw)%fly_dta(ni  ,nj+2)) -   &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj  ) - ref_wgts(kw)%fly_dta(ni  ,nj  )))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:)))
             END DO
           END DO
@@ -1007 +1099 @@
 
    END SUBROUTINE fld_interp
-  
+
+
+   FUNCTION ksec_week( cdday )
+      !!---------------------------------------------------------------------
+      !!                    ***  FUNCTION kshift_week *** 
+      !!
+      !! ** Purpose :  
+      !!
+      !! ** Method  :
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)   ::   cdday   !3 first letters of the first day of the weekly file
+      !!
+      INTEGER                        ::   ksec_week  ! output variable
+      INTEGER                        ::   ijul       !temp variable
+      INTEGER                        ::   ishift     !temp variable
+      CHARACTER(len=3),DIMENSION(7)  ::   cl_week 
+      !!----------------------------------------------------------------------
+      cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/)
+      DO ijul = 1, 7
+         IF( cl_week(ijul) == TRIM(cdday) ) EXIT
+      ENDDO
+      IF( ijul .GT. 7 )   CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): '//TRIM(cdday) )
+      !
+      ishift = ijul * NINT(rday)
+      ! 
+      ksec_week = nsec_week + ishift
+      ksec_week = MOD( ksec_week, 7*NINT(rday) )
+      ! 
+   END FUNCTION ksec_week
+
+
 END MODULE fldread

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

@@ -27 +27 @@
                                              ! they are only a useless overlay of rot_rep
 
+   PUBLIC   obs_rot
+
    REAL(wp), DIMENSION(jpi,jpj) ::   &
       gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point
@@ -38 +40 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -522 +524 @@
    END SUBROUTINE repere
 
+
+   SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE obs_rot  ***
+      !!
+      !! ** Purpose :   Copy gsinu, gcosu, gsinv and gsinv
+      !!                to input data for rotations of
+      !!                current at observation points
+      !!
+      !! History :
+      !!   9.2  !  09-02  (K. Mogensen)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   &
+         & psinu, pcosu, psinv, pcosv! copy of data
+
+      !!----------------------------------------------------------------------
+
+      ! Initialization of gsin* and gcos* at first call
+      ! -----------------------------------------------
+
+      IF( lmust_init ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~   coordinate transformation'
+
+         CALL angle       ! initialization of the transformation
+         lmust_init = .FALSE.
+
+      ENDIF
+
+      psinu(:,:) = gsinu(:,:)
+      pcosu(:,:) = gcosu(:,:)
+      psinv(:,:) = gsinv(:,:)
+      pcosv(:,:) = gcosv(:,:)
+
+   END SUBROUTINE obs_rot
+
+
   !!======================================================================
 END MODULE geo2ocean

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90

@@ -10 +10 @@
 #if defined key_oasis4
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 !##################### WARNING coupled mode ###############################

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

@@ -9 +9 @@
 #if defined key_lim3 || defined key_lim2
    !!----------------------------------------------------------------------
-   !!   'key_lim2' or 'key_lim3' :             LIM 2.0 or 3.0 sea-ice model
+   !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
@@ -23 +23 @@
 
 # if defined  key_lim2
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .TRUE.    !: LIM-2 ice model
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .FALSE.   !: no LIM-3
-   CHARACTER(len=1), PUBLIC            ::   cigr_type      = 'I'       !: 'I'-grid ice-velocity (B-grid lower left corner)
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3
+#  if defined key_lim2_vp
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'I'      !: VP : 'I'-grid ice-velocity (B-grid lower left corner)
+#  else
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: EVP: 'C'-grid ice-velocity
+#  endif
 # endif
 # if defined  key_lim3
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.   !: no LIM-2
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .TRUE.    !: LIM-3 ice model
-   CHARACTER(len=1), PUBLIC            ::   cigr_type      = 'C'       !: 'C'-grid ice-velocity
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .TRUE.   !: LIM-3 ice model
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: 'C'-grid ice-velocity
 # endif
 
@@ -41 +45 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau_ice    !: u-stress over ice (I-point for LIM2 or U,V-point for LIM3)   [N/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau_ice    !: v-stress over ice (I-point for LIM2 or U,V-point for LIM3)   [N/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of sol. rad. which penetrate inside the ice cover
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of sol. rad. which penetrate inside the ice cover
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau_ice    !: u-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau_ice    !: v-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of Qsr which penetrates inside the ice cover
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of Qsr which penetrates inside the ice cover
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_ice     !: solid freshwater budget over ice: sublivation - snow
 
@@ -55 +59 @@
    !!   Default option                      NO LIM 2.0 or 3.0 sea-ice model
    !!----------------------------------------------------------------------
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.  !: no LIM-2 ice model
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .FALSE.  !: no LIM-3 ice model
-   CHARACTER(len=1), PUBLIC            ::   cigr_type      = '-'      !: no grid ice-velocity
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity
 #endif
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE sbc_ice

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

@@ -4 +4 @@
    !! Surface module :   variables defined in core memory 
    !!======================================================================
-   !! History :  3.0   !  2006-06  (G. Madec)  Original code
-   !!             -    !  2008-08  (G. Madec)  namsbc moved from sbcmod
+   !! History :  3.0  ! 2006-06  (G. Madec)  Original code
+   !!             -   ! 2008-08  (G. Madec)  namsbc moved from sbcmod
+   !!            3.3  ! 2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
+   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
+   !!            3.3  ! 2010-10  (J. Chanut, C. Bricaud)  add the surface pressure forcing
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
@@ -24 +27 @@
    LOGICAL , PUBLIC ::   ln_rnf      = .FALSE.   !: runoffs / runoff mouths
    LOGICAL , PUBLIC ::   ln_ssr      = .FALSE.   !: Sea Surface restoring on SST and/or SSS      
+   LOGICAL , PUBLIC ::   ln_apr_dyn  = .FALSE.   !: Atmospheric pressure forcing used on dynamics (ocean & ice)
    INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2/3)
    INTEGER , PUBLIC ::   nn_fwb      = 0         !: FreshWater Budget: 
@@ -29 +33 @@
    !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step
    !                                             !:  = 2 annual global mean of e-p-r set to zero
-   INTEGER , PUBLIC ::   nn_ico_cpl  = 0          !: ice-ocean coupling indicator
-   !                                             !:  = 0   LIM-3 old case
-   !                                             !:  = 1   stresses computed using now ocean velocity
-   !                                             !:  = 2   combination of 0 and 1 cases
 
    !!----------------------------------------------------------------------
    !!              Ocean Surface Boundary Condition fields
    !!----------------------------------------------------------------------
-   LOGICAL , PUBLIC ::   lhftau = .FALSE.              !: HF tau contribution: mean of stress module - module of the mean stress
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau      !: sea surface i-stress (ocean referential)     [N/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau      !: sea surface j-stress (ocean referential)     [N/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   taum      !: module of sea surface stress (at T-point)    [N/m2] 
-   !! wndm is used only in PISCES to compute gases exchanges at the surface of the free ocean or in the leads in sea-ice parts
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   wndm      !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr       !: sea heat flux:     solar                     [W/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns       !: sea heat flux: non solar                     [W/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_tot   !: total     solar heat flux (over sea and ice) [W/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_tot   !: total non solar heat flux (over sea and ice) [W/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp       !: freshwater budget: volume flux               [Kg/m2/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emps      !: freshwater budget: concentration/dillution   [Kg/m2/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_tot   !: total evaporation - (liquid + solid) precpitation over oce and ice
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip   !: total precipitation           [Kg/m2/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip   !: solid precipitation           [Kg/m2/s]
-!!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rrunoff       !: runoff
-!!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   calving       !: calving
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr_i      !: ice fraction  (between 0 to 1)               -
+   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
+   !!                                   !!   now    ! before   !!
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   taum              !: module of sea surface stress (at T-point)    [N/m2] 
+   !! wndm is used only in PISCES to compute surface gases exchanges in ice-free ocean or leads
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr               !: sea heat flux:     solar                     [W/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]  
+   !!
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s]
+   !!
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip           !: total precipitation                          [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
 #if defined key_cpl_carbon_cycle
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2   !: atmospheric pCO2                             [ppm]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2           !: atmospheric pCO2                             [ppm]
 #endif
 
@@ -70 +74 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $ Id: $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
-
 END MODULE sbc_oce

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

@@ -39 +39 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -208 +208 @@
 
       ! Compute the emp flux such as its integration on the whole domain at each time is zero
-      IF( nbench /= 1 .AND. nbit_cmp /= 1 ) THEN
+      IF( nbench /= 1 ) THEN
          zsumemp = 0.e0   ;   zsurf = 0.e0
          DO jj = 1, jpj

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

@@ -37 +37 @@
    USE ice_2
 #endif
+
    IMPLICIT NONE
    PRIVATE
@@ -81 +82 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -137 +137 @@
 
          ! (NB: frequency positive => hours, negative => months)
-         !            !    file     ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
-         !            !    name     !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
-         sn_utau = FLD_N( 'utau'    ,    24     ,  'utau'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_vtau = FLD_N( 'vtau'    ,    24     ,  'vtau'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_wndm = FLD_N( 'mwnd10m' ,    24     ,  'm_10'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_tair = FLD_N( 'tair10m' ,    24     ,  't_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_humi = FLD_N( 'humi10m' ,    24     ,  'q_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_ccov = FLD_N( 'ccover'  ,    -1     ,  'cloud'   ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_prec = FLD_N( 'precip'  ,    -1     ,  'precip'  ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
+         !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_utau = FLD_N( 'utau'   ,    24     , 'utau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_vtau = FLD_N( 'vtau'   ,    24     , 'vtau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_wndm = FLD_N( 'mwnd10m',    24     , 'm_10'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_ccov = FLD_N( 'ccover' ,    -1     , 'cloud'  ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
 
          REWIND( numnam )                    ! ... read in namlist namsbc_clio
@@ -160 +160 @@
             CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf structure' )   ;   RETURN
          ENDIF
-
          DO ifpr= 1, jpfld
-            ALLOCATE( sf(ifpr)%fnow(jpi,jpj) )
-            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) )
-         END DO
-
-
+            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+            IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
+         END DO
          ! fill sf with slf_i and control print
          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_clio', 'flux formulation for ocean surface boundary condition', 'namsbc_clio' )
@@ -178 +175 @@
       !
 #if defined key_lim3      
-      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:)     !RB ugly patch
+      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)     !RB ugly patch
 #endif
-      !
-      IF(lwp .AND. nitend-nit000 <= 100 ) THEN
-         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' read monthly CLIO fluxes: ok, kt: ', kt
-            WRITE(numout,*)
-            ifpr = INT(jpi/8)      ;      jfpr = INT(jpj/10)
-            WRITE(numout,*) TRIM(sf(jp_utau)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_utau)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_vtau)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_vtau)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_humi)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_humi)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_wndm)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_wndm)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_ccov)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_ccov)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_prec)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_prec)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_tair)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_tair)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-         ENDIF
-      ENDIF
-
-      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
-          CALL blk_oce_clio( sf, sst_m )                  ! compute the surface ocean fluxes using CLIO bulk formulea
-      ENDIF                                               ! 
+      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_clio( sf, sst_m )
       !
    END SUBROUTINE sbc_blk_clio
@@ -270 +235 @@
       !------------------------------------!
 !CDIR COLLAPSE
-      DO jj = 1 , jpj
-         DO ji = 1, jpi
-            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj)
-            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj)
-         END DO
-      END DO
+      utau(:,:) = sf(jp_utau)%fnow(:,:,1)
+!CDIR COLLAPSE
+      vtau(:,:) = sf(jp_vtau)%fnow(:,:,1)
 
       !------------------------------------!
@@ -295 +257 @@
       !------------------------------------!
 !CDIR COLLAPSE
-      DO jj = 1 , jpj
-         DO ji = 1, jpi
-            wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj)
-         END DO
-      END DO
+      wndm(:,:) = sf(jp_wndm)%fnow(:,:,1)
 
       !------------------------------------------------!
@@ -317 +275 @@
             !
             zsst  = pst(ji,jj)              + rt0           ! converte Celcius to Kelvin the SST
-            ztatm = sf(jp_tair)%fnow(ji,jj)                 ! and set minimum value far above 0 K (=rt0 over land)
-            zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj)           ! fraction of clear sky ( 1 - cloud cover)
+            ztatm = sf(jp_tair)%fnow(ji,jj,1)               ! and set minimum value far above 0 K (=rt0 over land)
+            zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj,1)         ! fraction of clear sky ( 1 - cloud cover)
             zrhoa = zpatm / ( 287.04 * ztatm )              ! air density (equation of state for dry air) 
             ztamr = ztatm - rtt                             ! Saturation water vapour
@@ -325 +283 @@
             zmt3  = SIGN( 28.200, -ztamr )                  !           \/
             zes   = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 ) / ( ztatm - 35.86  + MAX( 0.e0, zmt3 ) )  )
-            zev    = sf(jp_humi)%fnow(ji,jj) * zes          ! vapour pressure  
+            zev    = sf(jp_humi)%fnow(ji,jj,1) * zes        ! vapour pressure  
             zevsqr = SQRT( zev * 0.01 )                     ! square-root of vapour pressure
             zqatm = 0.622 * zev / ( zpatm - 0.378 * zev )   ! specific humidity 
@@ -333 +291 @@
             !--------------------------------------!
             ztatm3  = ztatm * ztatm * ztatm
-            zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)    
+            zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)    
             ztaevbk = ztatm * ztatm3 * zcldeff * ( 0.39 - 0.05 * zevsqr ) 
             !
@@ -351 +309 @@
             zdeltaq = zqatm - zqsato
             ztvmoy  = ztatm * ( 1. + 2.2e-3 * ztatm * zqatm )
-            zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) * ztvmoy, zeps )
+            zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, zeps )
             zdtetar = zdteta / zdenum
             ztvmoyr = ztvmoy * ztvmoy * zdeltaq / zdenum
@@ -373 +331 @@
             zpsil   = zpsih
             
-            zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) / grav, zeps )
+            zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, zeps )
             zcmn           = vkarmn / LOG ( 10. / zvatmg )
             zchn           = 0.0327 * zcmn
@@ -387 +345 @@
             zcleo          = zcln * zclcm 
 
-            zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj)
+            zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj,1)
 
             ! sensible heat flux
@@ -403 +361 @@
 
 !CDIR COLLAPSE
-!CDIR NOVERRCHK
-      DO jj = 1, jpj
-!CDIR NOVERRCHK
-         DO ji = 1, jpi
-            qns (ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj)      ! Downward Non Solar flux
-            emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj) / rday * tmask(ji,jj,1)
-         END DO
-      END DO
+      emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
+      qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)         ! Downward Non Solar flux
       emps(:,:) = emp(:,:)
       !
@@ -476 +428 @@
       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
       !!
-      REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3             ! temporary scalars
+      REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3     ! temporary scalars
       REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         -
       REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         -
@@ -499 +451 @@
       SELECT CASE( cd_grid )
       CASE( 'C' )                          ! C-grid ice dynamics
-         ! Change from wind speed to wind stress over OCEAN (cao is used)
-         zcoef = cai / cao 
-!CDIR COLLAPSE
-         DO jj = 1 , jpj
-            DO ji = 1, jpi
-               p_taui(ji,jj) = zcoef * utau(ji,jj)
-               p_tauj(ji,jj) = zcoef * vtau(ji,jj)
-            END DO
-         END DO
-      CASE( 'B' )                          ! B-grid ice dynamics
-         ! Change from wind speed to wind stress over OCEAN (cao is used)
-         zcoef = 0.5 * cai / cao 
-         ! stress from ocean U- and V-points to ice U,V point
-!CDIR COLLAPSE
-         DO jj = 2, jpj
-            DO ji = 2, jpi   ! B grid : no vector opt.
+         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress
+         p_taui(:,:) = zcoef * utau(:,:)
+         p_tauj(:,:) = zcoef * vtau(:,:)
+      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner)
+         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress
+         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point
+            DO ji = 2, jpi   ! I-grid : no vector opt.
                p_taui(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) )
                p_tauj(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) )
             END DO
          END DO
-         CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
-         CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
+         CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point
       END SELECT
 
@@ -532 +474 @@
 !CDIR NOVERRCHK
          DO ji = 1, jpi
-            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj)                  ! air temperature in Kelvins 
+            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                ! air temperature in Kelvins 
       
             zrhoa(ji,jj) = zpatm / ( 287.04 * ztatm(ji,jj) )         ! air density (equation of state for dry air) 
@@ -543 +485 @@
                &                / ( ztatm(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  )
 
-            zev = sf(jp_humi)%fnow(ji,jj) * zes                      ! vapour pressure  
+            zev = sf(jp_humi)%fnow(ji,jj,1) * zes                    ! vapour pressure  
             zevsqr(ji,jj) = SQRT( zev * 0.01 )                       ! square-root of vapour pressure
             zqatm(ji,jj) = 0.622 * zev / ( zpatm - 0.378 * zev )     ! specific humidity 
@@ -553 +495 @@
             zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) )
             zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) )
-            p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj) / rday   &        ! rday = converte mm/day to kg/m2/s
+            p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s
                &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s]
                &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   &
@@ -563 +505 @@
             ! fraction of qsr_ice which is NOT absorbed in the thin surface layer
             ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
-            p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj) 
-            p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj)
+            p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 
+            p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)
          END DO
       END DO
@@ -586 +528 @@
                !-------------------------------------------!
                ztatm3  = ztatm(ji,jj) * ztatm(ji,jj) * ztatm(ji,jj)
-               zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)    
+               zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)    
                ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 
                !
@@ -611 +553 @@
                
                !  sensible and latent fluxes over ice
-               zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj)      ! computation of intermediate values
+               zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj,1)      ! computation of intermediate values
                zrhovaclei = zrhova * zcshi * 2.834e+06
                zrhovacshi = zrhova * zclei * 1004.0
@@ -641 +583 @@
       p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux
 !CDIR COLLAPSE
-      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:) / rday                       ! total precipitation [kg/m2/s]
+      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
       !
 !!gm : not necessary as all input data are lbc_lnk...
@@ -737 +679 @@
 !CDIR NOVERRCHK
          DO ji = 1, jpi
-            ztamr = sf(jp_tair)%fnow(ji,jj) - rtt
+            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt
             zmt1  = SIGN( 17.269,  ztamr )
             zmt2  = SIGN( 21.875,  ztamr )
             zmt3  = SIGN( 28.200, -ztamr )
             zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour
-               &                     / ( sf(jp_tair)%fnow(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  )
-            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj) * zes * 1.0e-05                   ! vapour pressure  
+               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  )
+            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                 ! vapour pressure  
          END DO
       END DO
@@ -800 +742 @@
 
                ! ocean albedo depending on the cloud cover (Payne, 1972)
-               za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky
-                  &       +         sf(jp_ccov)%fnow(ji,jj)   * 0.06                                     ! overcast
+               za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky
+                  &       +         sf(jp_ccov)%fnow(ji,jj,1)   * 0.06                                     ! overcast
 
                   ! solar heat flux absorbed by the ocean (Zillman, 1972)
@@ -816 +758 @@
          DO ji = 1, jpi
             zlmunoon = ASIN( zps(ji,jj) + zpc(ji,jj) ) / rad                         ! local noon solar altitude
-            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj)   &       ! cloud correction (Reed 1977)
+            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1)   &     ! cloud correction (Reed 1977)
                &                          + 0.0019 * zlmunoon )                 )
-            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)   ! and zcoef1: ellipsity
+            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)    ! and zcoef1: ellipsity
          END DO
       END DO
@@ -867 +809 @@
 !CDIR NOVERRCHK
          DO ji = 1, jpi           
-            ztamr = sf(jp_tair)%fnow(ji,jj) - rtt           
+            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt           
             zmt1  = SIGN( 17.269,  ztamr )
             zmt2  = SIGN( 21.875,  ztamr )
             zmt3  = SIGN( 28.200, -ztamr )
             zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour
-               &                     / ( sf(jp_tair)%fnow(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  )
-            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj) * zes * 1.0e-05                   ! vapour pressure  
+               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  )
+            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                 ! vapour pressure  
          END DO
       END DO
@@ -940 +882 @@
                      &        / (  1.0 + 0.139  * stauc(ji,jj) * ( 1.0 - 0.9435 * pa_ice_os(ji,jj,jl) ) )       
              
-                  pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + (  ( 1.0 - sf(jp_ccov)%fnow(ji,jj) ) * zqsr_ice_cs    &
-                     &                                       +         sf(jp_ccov)%fnow(ji,jj)   * zqsr_ice_os  )
+                  pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + (  ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * zqsr_ice_cs    &
+                     &                                       +         sf(jp_ccov)%fnow(ji,jj,1)   * zqsr_ice_os  )
                END DO
             END DO

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

@@ -12 +12 @@
    !!            3.0  !  2006-06  (G. Madec) sbc rewritting   
    !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put
+   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
    !!----------------------------------------------------------------------
 
@@ -26 +27 @@
    USE fldread         ! read input fields
    USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbcdcy          ! surface boundary condition: diurnal cycle
    USE iom             ! I/O manager library
    USE in_out_manager  ! I/O manager
@@ -34 +36 @@
    USE sbc_ice         ! Surface boundary condition: ice fields
 #endif
-
 
    IMPLICIT NONE
@@ -61 +62 @@
    REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant
    REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice
-
-   !                                !!* Namelist namsbc_core : CORE bulk parameters
-   LOGICAL  ::   ln_2m     = .FALSE.     ! logical flag for height of air temp. and hum
-   LOGICAL  ::   ln_taudif = .FALSE.     ! logical flag to use the "mean of stress module - module of mean stress" data
-   REAL(wp) ::   rn_pfac   = 1.          ! multiplication factor for precipitation
+   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be contant
+
+   !                                  !!* Namelist namsbc_core : CORE bulk parameters
+   LOGICAL  ::   ln_2m     = .FALSE.   ! logical flag for height of air temp. and hum
+   LOGICAL  ::   ln_taudif = .FALSE.   ! logical flag to use the "mean of stress module - module of mean stress" data
+   REAL(wp) ::   rn_pfac   = 1.        ! multiplication factor for precipitation
 
    !! * Substitutions
@@ -71 +73 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -132 +133 @@
          !
          ! (NB: frequency positive => hours, negative => months)
-         !            !    file     ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
-         !            !    name     !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
-         sn_wndi = FLD_N( 'uwnd10m' ,    24     ,  'u_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_wndj = FLD_N( 'vwnd10m' ,    24     ,  'v_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_qsr  = FLD_N( 'qsw'     ,    24     ,  'qsw'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_qlw  = FLD_N( 'qlw'     ,    24     ,  'qlw'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_tair = FLD_N( 'tair10m' ,    24     ,  't_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_humi = FLD_N( 'humi10m' ,    24     ,  'q_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_prec = FLD_N( 'precip'  ,    -1     ,  'precip'  ,  .true.    , .false. ,   'yearly'  , ''       , ''         )
-         sn_snow = FLD_N( 'snow'    ,    -1     ,  'snow'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         )
-         sn_tdif = FLD_N( 'taudif'  ,    24     ,  'taudif'  ,  .true.    , .false. ,   'yearly'  , ''       , ''         )
+         !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_wndi = FLD_N( 'uwnd10m',    24     , 'u_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_wndj = FLD_N( 'vwnd10m',    24     , 'v_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_qsr  = FLD_N( 'qsw'    ,    24     , 'qsw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_qlw  = FLD_N( 'qlw'    ,    24     , 'qlw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
+         sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
+         sn_tdif = FLD_N( 'taudif' ,    24     , 'taudif' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
          !
-         REWIND( numnam )                    ! ... read in namlist namsbc_core
+         REWIND( numnam )                          ! read in namlist namsbc_core
          READ  ( numnam, namsbc_core )
-         !
-         ! store namelist information in an array
+         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
+         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
+            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
+         IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN
+            CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   &
+                 &         '              ==> We force time interpolation = .false. for qsr' )
+            sn_qsr%ln_tint = .false.
+         ENDIF
+         !                                         ! store namelist information in an array
          slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj
          slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw
@@ -153 +161 @@
          slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow
          slf_i(jp_tdif) = sn_tdif
-         !
-         ! do we use HF tau information?
-         lhftau = ln_taudif
+         !                 
+         lhftau = ln_taudif                        ! do we use HF tau information?
          jfld = jpfld - COUNT( (/.NOT. lhftau/) )
          !
-         ! set sf structure
-         ALLOCATE( sf(jfld), STAT=ierror )
+         ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure
          IF( ierror > 0 ) THEN
             CALL ctl_stop( 'sbc_blk_core: unable to allocate sf structure' )   ;   RETURN
          ENDIF
          DO ifpr= 1, jfld
-            ALLOCATE( sf(ifpr)%fnow(jpi,jpj) )
-            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) )
+            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+            IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
          END DO
-         !
-         ! fill sf with slf_i and control print
-         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulattion for ocean surface boundary condition', 'namsbc_core' )
+         !                                         ! fill sf with slf_i and control print
+         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' )
          !
       ENDIF
 
-      CALL fld_read( kt, nn_fsbc, sf )                   ! input fields provided at the current time-step
+      CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step
 
 #if defined key_lim3
-      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:)
+      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)                  ! LIM3: make Tair available in sea-ice
 #endif
-
-      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
-          CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m )   ! compute the surface ocean fluxes using CLIO bulk formulea
-      ENDIF
-      !                                                  ! using CORE bulk formulea
+      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m )
+      !
    END SUBROUTINE sbc_blk_core
    
@@ -244 +247 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
-            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
          END DO
       END DO
@@ -260 +263 @@
       ! ----------------------------------------------------------------------------- !
     
-      ! ocean albedo assumed to be 0.066
-!CDIR COLLAPSE
-      qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:) * tmask(:,:,1)                                 ! Short Wave
-!CDIR COLLAPSE
-      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
-                      
+      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
+      zztmp = 1. - albo
+      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
+      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
+      ENDIF
+!CDIR COLLAPSE
+      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
       ! ----------------------------------------------------------------------------- !
       !     II    Turbulent FLUXES                                                    !
@@ -307 +311 @@
       IF( lhftau ) THEN 
 !CDIR COLLAPSE
-         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:)
+         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1)
       ENDIF
       CALL iom_put( "taum_oce", taum )   ! output wind stress module
@@ -330 +334 @@
       ELSE
 !CDIR COLLAPSE
-         zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:) ) * wndm(:,:) )   ! Evaporation
-!CDIR COLLAPSE
-         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:) ) * wndm(:,:)     ! Sensible Heat
+         zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation
+!CDIR COLLAPSE
+         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat
       ENDIF
 !CDIR COLLAPSE
@@ -355 +359 @@
       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux
 !CDIR COLLAPSE
-      emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * rn_pfac * tmask(:,:,1)
+      emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)
 !CDIR COLLAPSE
       emps(:,:) = emp(:,:)
@@ -392 +396 @@
       !! caution : the net upward water flux has with mm/day unit
       !!---------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)      ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)    ::   pui      ! ice surface velocity (i- and i- components      [m/s]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)    ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid)
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)      ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   p_taui   ! i- & j-components of surface ice stress        [N/m2]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid)
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)      ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)      ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)      ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)      ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(:,:,:)      ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%]
-      CHARACTER(len=1), INTENT(in   )                ::   cd_grid  ! ice grid ( C or B-grid)
-      INTEGER, INTENT(in   )                         ::   pdim     ! number of ice categories
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid)
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid)
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%]
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid)
+      INTEGER                     , INTENT(in   ) ::   pdim     ! number of ice categories
       !!
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
@@ -414 +418 @@
       REAL(wp) ::   zst2, zst3
       REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb
+      REAL(wp) ::   zztmp                                        ! temporary variable
       REAL(wp) ::   zcoef_frca                                   ! fractional cloud amount
       REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point
@@ -427 +432 @@
 
       ! local scalars ( place there for vector optimisation purposes)
-      zcoef_wnorm = rhoa * Cice
+      zcoef_wnorm  = rhoa * Cice
       zcoef_wnorm2 = rhoa * Cice * 0.5
-      zcoef_dqlw = 4.0 * 0.95 * Stef
-      zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8)
-      zcoef_dqsb = rhoa * cpa * Cice
-      zcoef_frca = 1.0  - 0.3
+      zcoef_dqlw   = 4.0 * 0.95 * Stef
+      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8)
+      zcoef_dqsb   = rhoa * cpa * Cice
+      zcoef_frca   = 1.0  - 0.3
 
 !!gm brutal....
@@ -444 +449 @@
       ! ----------------------------------------------------------------------------- !
       SELECT CASE( cd_grid )
-      CASE( 'B' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
+      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
          !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked)
 !CDIR NOVERRCHK
          DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! B grid : no vector opt
+            DO ji = 2, jpim1   ! B grid : NO vector opt
                ! ... scalar wind at I-point (fld being at T-point)
-               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ) + sf(jp_wndi)%fnow(ji  ,jj  )   &
-                  &              + sf(jp_wndi)%fnow(ji-1,jj-1) + sf(jp_wndi)%fnow(ji  ,jj-1)  ) - pui(ji,jj)
-               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ) + sf(jp_wndj)%fnow(ji  ,jj  )   &
-                  &              + sf(jp_wndj)%fnow(ji-1,jj-1) + sf(jp_wndj)%fnow(ji  ,jj-1)  ) - pvi(ji,jj)
+               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   &
+                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - pui(ji,jj)
+               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   &
+                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - pvi(ji,jj)
                zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
                ! ... ice stress at I-point
@@ -459 +464 @@
                p_tauj(ji,jj) = zwnorm_f * zwndj_f
                ! ... scalar wind at T-point (fld being at T-point)
-               zwndi_t = sf(jp_wndi)%fnow(ji,jj) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   &
-                  &                                        + pui(ji,jj  ) + pui(ji+1,jj  )  )
-               zwndj_t = sf(jp_wndj)%fnow(ji,jj) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   &
-                  &                                        + pvi(ji,jj  ) + pvi(ji+1,jj  )  )
+               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   &
+                  &                                          + pui(ji,jj  ) + pui(ji+1,jj  )  )
+               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   &
+                  &                                          + pvi(ji,jj  ) + pvi(ji+1,jj  )  )
                z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
             END DO
@@ -476 +481 @@
          DO jj = 2, jpj
             DO ji = fs_2, jpi   ! vect. opt.
-               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  )
-               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  )
+               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  )
+               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  )
                z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
             END DO
@@ -486 +491 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vect. opt.
-               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj) + z_wnds_t(ji,jj) )                          &
-                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj) + sf(jp_wndi)%fnow(ji,jj) ) - pui(ji,jj) )
-               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1) + z_wnds_t(ji,jj) )                          &
-                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1) + sf(jp_wndj)%fnow(ji,jj) ) - pvi(ji,jj) )
+               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) )
+               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) )
             END DO
          END DO
@@ -498 +503 @@
       END SELECT
 
+      zztmp = 1. / ( 1. - albo )
       !                                     ! ========================== !
       DO jl = 1, ijpl                       !  Loop over ice categories  !
@@ -512 +518 @@
                zst3 = pst(ji,jj,jl) * zst2
                ! Short Wave (sw)
-               p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj) * tmask(ji,jj,1)
+               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
                ! Long  Wave (lw)
-               z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj)       &                         
-                  &                   - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1)
+               z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1)
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                               
@@ -525 +530 @@
                ! ... turbulent heat fluxes
                ! Sensible Heat
-               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj) )
+               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
                ! Latent Heat
                p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                           
-                  &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj)  ) )
+                  &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
                ! Latent heat sensitivity for ice (Dqla/Dt)
                p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )
@@ -558 +563 @@
        
 !CDIR COLLAPSE
-      p_tpr(:,:) = sf(jp_prec)%fnow(:,:) * rn_pfac      ! total precipitation [kg/m2/s]
-!CDIR COLLAPSE
-      p_spr(:,:) = sf(jp_snow)%fnow(:,:) * rn_pfac      ! solid precipitation [kg/m2/s]
+      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s]
+!CDIR COLLAPSE
+      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
       CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation 
       !
@@ -597 +602 @@
       !!   9.0  !  05-08  (L. Brodeau) Rewriting and optimization
       !!----------------------------------------------------------------------
-      !! * Arguments
-
       REAL(wp), INTENT(in) :: zu                 ! altitude of wind measurement       [m]
       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::  &
@@ -638 +641 @@
          grav   = 9.8,          &  ! gravity                       
          kappa  = 0.4              ! von Karman s constant
-
+      !!----------------------------------------------------------------------
       !! * Start
       !! Air/sea differences
@@ -762 +765 @@
          grav   = 9.8,      &  ! gravity                       
          kappa  = 0.4          ! von Karman's constant
-
+      !!----------------------------------------------------------------------
       !!  * Start
 

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

@@ -4 +4 @@
    !! Surface Boundary Condition :  momentum, heat and freshwater fluxes in coupled mode
    !!======================================================================
-   !! History :  2.0  !  06-2007  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
-   !!            3.0  !  02-2008  (G. Madec, C Talandier)  surface module
-   !!            3.1  !  02-2009  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
+   !! History :  2.0  ! 2007-06  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
+   !!            3.0  ! 2008-02  (G. Madec, C Talandier)  surface module
+   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
    !!----------------------------------------------------------------------
 #if defined key_oasis3 || defined key_oasis4
@@ -23 +23 @@
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
+   USE sbcdcy          ! surface boundary condition: diurnal cycle
    USE phycst          ! physical constants
 #if defined key_lim3
    USE par_ice         ! ice parameters
+   USE ice             ! ice variables
 #endif
 #if defined key_lim2
@@ -163 +165 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -527 +529 @@
       CALL cpl_prism_define(jprcv, jpsnd)            
       !
+      IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   &
+         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
+
    END SUBROUTINE sbc_cpl_init
 
@@ -728 +733 @@
          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce) 
          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(:,:,jpr_qsrmix)
+         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle
          !
          !                                                       ! total freshwater fluxes over the ocean (emp, emps)
@@ -783 +789 @@
       !! ** Method  :   transform the received stress from the atmosphere into
       !!             an atmosphere-ice stress in the (i,j) ocean referencial
-      !!             and at the velocity point of the sea-ice model (cigr_type):
+      !!             and at the velocity point of the sea-ice model (cp_ice_msh):
       !!                'C'-grid : i- (j-) components given at U- (V-) point 
-      !!                'B'-grid : both components given at I-point 
+      !!                'I'-grid : B-grid lower-left corner: both components given at I-point 
       !!
       !!                The received stress are :
@@ -798 +804 @@
       !!                 first  as  2 components on the sphere 
       !!                 second as  2 components oriented along the local grid
-      !!                 third  as  2 components on the cigr_type point 
+      !!                 third  as  2 components on the cp_ice_msh point 
       !!
       !!                In 'oce and ice' case, only one vector stress field 
@@ -804 +810 @@
       !!             so that it is now defined as (i,j) components given at U-
       !!             and V-points, respectively. Therefore, here only the third
-      !!             transformation is done and only if the ice-grid is a 'B'-grid. 
-      !!
-      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cigr_type point
+      !!             transformation is done and only if the ice-grid is a 'I'-grid. 
+      !!
+      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
@@ -867 +873 @@
          !    
          !                                                  j+1   j     -----V---F
-         ! ice stress on ice velocity point (cigr_type)                  !       |
+         ! ice stress on ice velocity point (cp_ice_msh)                 !       |
          ! (C-grid ==>(U,V) or B-grid ==> I or F)                 j      |   T   U
          !                                                               |       |
@@ -874 +880 @@
          !                                                              i-1  i   i
          !                                                               i      i+1 (for I)
-         SELECT CASE ( cigr_type )
+         SELECT CASE ( cp_ice_msh )
             !
          CASE( 'I' )                                         ! B-grid ==> I
@@ -1159 +1165 @@
             &                     + palbi         (:,:,1) * zicefr(:,:,1) ) )
       END SELECT
+      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle
+         pqsr_tot(:,:  ) = sbc_dcy( pqsr_tot(:,:  ) )
+         pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) )
+      ENDIF
 
       SELECT CASE( TRIM( cn_rcv_dqnsdt ) )
@@ -1249 +1259 @@
             END DO
          CASE( 'weighted oce and ice' )   
-            SELECT CASE ( cigr_type )
+            SELECT CASE ( cp_ice_msh )
             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
                DO jj = 2, jpjm1
@@ -1284 +1294 @@
             CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
          CASE( 'mixed oce-ice'        )
-            SELECT CASE ( cigr_type )
+            SELECT CASE ( cp_ice_msh )
             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
                DO jj = 2, jpjm1

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

@@ -4 +4 @@
    !! Ocean forcing:  momentum, heat and freshwater flux formulation
    !!=====================================================================
-   !! History :  9.0   !  06-06  (G. Madec)  Original code
+   !! History :  1.0  !  2006-06  (G. Madec)  Original code
+   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   namflx   : flux formulation namlist
-   !!   sbc_flx  : flux formulation as ocean surface boundary condition
-   !!              (forced mode, fluxes read in NetCDF files)
-   !!----------------------------------------------------------------------
-   !! question diverses
-   !!  *   ajouter un test sur la division entier de freqh et rdttra ???
-   !!  **  ajoute dans namelist: 1 year forcing files
-   !!                         or forcing file starts at the begining of the run
-   !!  *** we assume that the forcing file start and end with the previous
-   !!      year last record and the next year first record (useful for
-   !!      time interpolation, required even if no time interp???)
-   !!  *   ajouter un test sur la division de la frequence en pas de temps
-   !!  ==> daymod ajout de nsec_year = number of second since the begining of the year
-   !!      assumed to be 0 at 0h january the 1st (i.e. 24h december the 31)
-   !!
-   !!  *** regrouper dtatem et dtasal
+   !!   sbc_flx  : flux formulation as ocean surface boundary condition (forced mode, fluxes read in NetCDF files)
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr
    USE phycst          ! physical constants
    USE fldread         ! read input fields
@@ -52 +40 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -98 +85 @@
       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
       !!---------------------------------------------------------------------
-      !                                         ! ====================== !
-      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
-         !                                      ! ====================== !
+      !
+      IF( kt == nit000 ) THEN                ! First call kt=nit000  
          ! set file information
          cn_dir = './'        ! directory in which the model is executed
          ! ... default values (NB: frequency positive => hours, negative => months)
-         !              !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
-         !              !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
-         sn_utau = FLD_N(   'utau'  ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_vtau = FLD_N(   'vtau'  ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_qtot = FLD_N(   'qtot'  ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_qsr  = FLD_N(   'qsr'   ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_emp  = FLD_N(   'emp'   ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-
-         REWIND ( numnam )               ! ... read in namlist namflx
+         !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  !
+         !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     !
+         sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         !
+         REWIND ( numnam )                         ! read in namlist namflx
          READ   ( numnam, namsbc_flx ) 
-
-         ! store namelist information in an array
+         !
+         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
+         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &
+            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
+         !
+         !                                         ! store namelist information in an array
          slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
          slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
          slf_i(jp_emp ) = sn_emp
-
-         ! set sf structure
-         ALLOCATE( sf(jpfld), STAT=ierror )
+         !
+         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
          IF( ierror > 0 ) THEN   
             CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN  
          ENDIF
          DO ji= 1, jpfld
-            ALLOCATE( sf(ji)%fnow(jpi,jpj) )
-            ALLOCATE( sf(ji)%fdta(jpi,jpj,2) )
+            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
+            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
          END DO
-
-
-         ! fill sf with slf_i and control print
+         !                                         ! fill sf with slf_i and control print
          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
          !
       ENDIF
 
-      CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the
-      !                                          ! input fields at the current time-step
+      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step
+     
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency
 
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-         !
-         ! set the ocean fluxes from read fields
+         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle
+         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
+         ENDIF
 !CDIR COLLAPSE
-         DO jj = 1, jpj
+         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
             DO ji = 1, jpi
-               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj)
-               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj)
-               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - sf(jp_qsr)%fnow(ji,jj)
-               qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj)
-               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj)
+               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
+               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
+               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
+               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
             END DO
          END DO
-         
-         ! module of wind stress and wind speed at T-point
-         zcoef = 1. / ( zrhoa * zcdrag ) 
+         !                                                        ! module of wind stress and wind speed at T-point
+         zcoef = 1. / ( zrhoa * zcdrag )
 !CDIR NOVERRCHK
          DO jj = 2, jpjm1
@@ -168 +154 @@
          CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
 
-         ! Initialization of emps (when no ice model)
-         emps(:,:) = emp (:,:) 
+         emps(:,:) = emp (:,:)                                    ! Initialization of emps (needed when no ice model)
                   
-         ! control print (if less than 100 time-step asked)
-         IF( nitend-nit000 <= 100 .AND. lwp ) THEN
+         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked)
             WRITE(numout,*) 
             WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

@@ -4 +4 @@
    !! Ocean fluxes   : domain averaged freshwater budget
    !!======================================================================
-   !! History :  8.2  !  01-02  (E. Durand)  Original code
-   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
-   !!            9.0  !  06-08  (G. Madec)  Surface module
-   !!            9.2  !  09-07  (C. Talandier) emp mean s spread over erp area 
+   !! History :  OPA  ! 2001-02  (E. Durand)  Original code
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            3.0  ! 2006-08  (G. Madec)  Surface module
+   !!            3.2  ! 2009-07  (C. Talandier) emp mean s spread over erp area 
    !!----------------------------------------------------------------------
 
@@ -23 +23 @@
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions
+   USE lib_fortran
 
    IMPLICIT NONE
@@ -31 +32 @@
    REAL(wp) ::   a_fwb_b            ! annual domain averaged freshwater budget
    REAL(wp) ::   a_fwb              ! for 2 year before (_b) and before year.
-   REAL(wp) ::   empold             ! empold to be suppressed
+   REAL(wp) ::   fwfold             ! fwfold to be suppressed
    REAL(wp) ::   area               ! global mean ocean surface (interior domain)
 
-   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2_i    ! area of the interior domain (e1t*e2t*tmask_i)
+   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2    ! area of the interior domain (e1t*e2t)
 
    !! * Substitutions
@@ -40 +41 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -65 +66 @@
       INTEGER  ::   inum                  ! temporary logical unit
       INTEGER  ::   ikty, iyear           ! 
-      REAL(wp) ::   z_emp, z_emp_nsrf, zsum_emp, zsum_erp       ! temporary scalars
+      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp       ! temporary scalars
       REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread
       REAL(wp), DIMENSION(jpi,jpj) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread
@@ -72 +73 @@
       !
       IF( kt == nit000 ) THEN
-         !
          IF(lwp) THEN
             WRITE(numout,*)
@@ -79 +79 @@
             IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero'
             IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget'
-            IF( kn_fwb == 3 )   WRITE(numout,*) '          emp set to zero and spread out over erp area'
+            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area'
          ENDIF
          !
          IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
          !
-         e1e2_i(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
-         area = SUM( e1e2_i(:,:) )
-         IF( lk_mpp )   CALL  mpp_sum( area    )   ! sum over the global domain
-         !
+         e1e2(:,:) = e1t(:,:) * e2t(:,:) 
+         area = glob_sum( e1e2(:,:) )           ! interior global domain surface
       ENDIF
       
@@ -93 +91 @@
       SELECT CASE ( kn_fwb )
       !
-      CASE ( 0 )                               
-         WRITE(ctmp1,*)'sbc_fwb : nn_fwb = ', kn_fwb, ' is not yet associated to an option, choose either 1/2'
-         CALL ctl_stop( ctmp1 )
+      CASE ( 1 )                             !==  global mean fwf set to zero  ==!
          !
-         
-      !
-      CASE ( 1 )                               ! global mean emp set to zero
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            z_emp = SUM( e1e2_i(:,:) * emp(:,:) ) / area
-            IF( lk_mpp )   CALL  mpp_sum( z_emp    )   ! sum over the global domain
-            emp (:,:) = emp (:,:) - z_emp
-            emps(:,:) = emps(:,:) - z_emp
+            z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain
+            emp (:,:) = emp (:,:) - z_fwf 
+            emps(:,:) = emps(:,:) - z_fwf 
          ENDIF
          !
-      CASE ( 2 )                               ! emp budget adjusted from the previous year
-         ! initialisation
-         IF( kt == nit000 ) THEN
-            ! Read the corrective factor on precipitations (empold)
+      CASE ( 2 )                             !==  fwf budget adjusted from the previous year  ==!
+         !
+         IF( kt == nit000 ) THEN                   ! initialisation
+            !                                         ! Read the corrective factor on precipitations (fwfold)
             CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
             READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb
             CLOSE( inum )
-            empold = a_fwb                  ! current year freshwater budget correction
-            !                               ! estimate from the previous year budget
+            fwfold = a_fwb                            ! current year freshwater budget correction
+            !                                         ! estimate from the previous year budget
             IF(lwp)WRITE(numout,*)
-            IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear  , ' freshwater budget correction = ', empold
+            IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear  , ' freshwater budget correction = ', fwfold
             IF(lwp)WRITE(numout,*)'          year = ',iyear-1, ' freshwater budget read       = ', a_fwb
             IF(lwp)WRITE(numout,*)'          year = ',iyear-2, ' freshwater budget read       = ', a_fwb_b
          ENDIF   
-         ! 
-         ! Update empold if new year start
+         !                                         ! Update fwfold if new year start
          ikty = 365 * 86400 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!!
          IF( MOD( kt, ikty ) == 0 ) THEN
             a_fwb_b = a_fwb
-            a_fwb   = SUM( e1e2_i(:,:) * sshn(:,:) )
-            IF( lk_mpp )   CALL  mpp_sum( a_fwb    )   ! sum over the global domain
+            a_fwb   = glob_sum( e1e2(:,:) * sshn(:,:) )   ! sum over the global domain
             a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s
 !!gm        !                                                      !!bug 365d year 
-            empold =  a_fwb                 ! current year freshwater budget correction
-            !                               ! estimate from the previous year budget
+            fwfold =  a_fwb                           ! current year freshwater budget correction
+            !                                         ! estimate from the previous year budget
          ENDIF
          ! 
-         ! correct the freshwater fluxes
-         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            emp (:,:) = emp (:,:) + empold
-            emps(:,:) = emps(:,:) + empold
+         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN      ! correct the freshwater fluxes
+            emp (:,:) = emp (:,:) + fwfold
+            emps(:,:) = emps(:,:) + fwfold
          ENDIF
          !
-         ! save empold value in a file
-         IF( kt == nitend .AND. lwp ) THEN
+         IF( kt == nitend .AND. lwp ) THEN         ! save fwfold value in a file
             CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
             WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb
@@ -147 +135 @@
          ENDIF
          !
-      CASE ( 3 )                               ! global emp set to zero and spread out over erp area
+      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==!
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            ! Select <0 and >0 area of erp
-            ztmsk_pos(:,:) = tmask_i(:,:)
-            WHERE( erp < 0.e0 ) ztmsk_pos = 0.e0
+            ztmsk_pos(:,:) = tmask_i(:,:)                      ! Select <0 and >0 area of erp
+            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp
             ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
-
-            ! Area filled by <0 and >0 erp 
-            zsurf_neg = SUM( e1e2_i(:,:)*ztmsk_neg(:,:) )
-            zsurf_pos = SUM( e1e2_i(:,:)*ztmsk_pos(:,:) )
-        
-            ! emp global mean 
-            z_emp = SUM( e1e2_i(:,:) * emp(:,:) ) / area
             !
-            IF( lk_mpp )   CALL  mpp_sum( z_emp )
-            IF( lk_mpp )   CALL  mpp_sum( zsurf_neg )
-            IF( lk_mpp )   CALL  mpp_sum( zsurf_pos )
-            
-            IF( z_emp < 0.e0 ) THEN
-                ! to spread out over >0 erp area to increase evaporation damping process
-                zsurf_tospread = zsurf_pos
+            zsurf_neg = glob_sum( e1e2(:,:)*ztmsk_neg(:,:) )   ! Area filled by <0 and >0 erp 
+            zsurf_pos = glob_sum( e1e2(:,:)*ztmsk_pos(:,:) )
+            !                                                  ! fwf global mean 
+            z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area
+            !            
+            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
+                zsurf_tospread      = zsurf_pos
                 ztmsk_tospread(:,:) = ztmsk_pos(:,:)
-            ELSE
-                ! to spread out over <0 erp area to increase precipitation damping process
-                zsurf_tospread = zsurf_neg
+            ELSE                             ! spread out over <0 erp area to increase precipitation
+                zsurf_tospread      = zsurf_neg
                 ztmsk_tospread(:,:) = ztmsk_neg(:,:)
             ENDIF
-
-            ! emp global mean over <0 or >0 erp area
-            zsum_emp = SUM( e1e2_i(:,:) * z_emp )
-            IF( lk_mpp )   CALL  mpp_sum( zsum_emp )
-            z_emp_nsrf =  zsum_emp / ( zsurf_tospread + rsmall )
-            ! weight to respect erp field 2D structure 
-            zsum_erp = SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) )
-            IF( lk_mpp )   CALL  mpp_sum( zsum_erp )
+            !
+            zsum_fwf   = glob_sum( e1e2(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area
+!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so....
+            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )
+            !                                                  ! weight to respect erp field 2D structure 
+            zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2(:,:) )
             z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
-
-            ! final correction term to apply
-            zerp_cor(:,:) = -1. * z_emp_nsrf * zsurf_tospread * z_wgt(:,:)
-
+            !                                                  ! final correction term to apply
+            zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:)
+            !
+!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain !
             CALL lbc_lnk( zerp_cor, 'T', 1. )
-
+            !
             emp (:,:) = emp (:,:) + zerp_cor(:,:)
             emps(:,:) = emps(:,:) + zerp_cor(:,:)
             erp (:,:) = erp (:,:) + zerp_cor(:,:)
-            
-            IF( nprint == 1 .AND. lwp ) THEN
-               IF( z_emp < 0.e0 ) THEN
-                  WRITE(numout,*)'       z_emp < 0'
-                  WRITE(numout,*)'       SUM(erp+)        = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2_i(:,:) )*1.e-3,' m3.s-1'
+            !
+            IF( nprint == 1 .AND. lwp ) THEN                   ! control print
+               IF( z_fwf < 0._wp ) THEN
+                  WRITE(numout,*)'   z_fwf < 0'
+                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv'
                ELSE
-                   WRITE(numout,*)'      z_emp >= 0'
-                   WRITE(numout,*)'      SUM(erp-)        = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2_i(:,:) )*1.e-3,' m3.s-1'
+                  WRITE(numout,*)'   z_fwf >= 0'
+                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv'
                ENDIF
-               WRITE(numout,*)'      SUM(empG)        = ', SUM( z_emp*e1e2_i(:,:) )*1.e-3,' m3.s-1'
-               WRITE(numout,*)'      z_emp            = ', z_emp      ,' mm.s-1'
-               WRITE(numout,*)'      z_emp_nsrf       = ', z_emp_nsrf ,' mm.s-1'
-               WRITE(numout,*)'      MIN(zerp_cor)    = ', MINVAL(zerp_cor) 
-               WRITE(numout,*)'      MAX(zerp_cor)    = ', MAXVAL(zerp_cor) 
+               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2(:,:) )*1.e-9,' Sv'
+               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s'
+               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s'
+               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor) 
+               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor) 
             ENDIF
-            !
          ENDIF
          !
-      CASE DEFAULT    ! you should never be there
-         WRITE(ctmp1,*)'sbc_fwb : nn_fwb = ', kn_fwb, ' is not permitted for the FreshWater Budget correction, choose either 1/2'
-         CALL ctl_stop( ctmp1 )
+      CASE DEFAULT                           !==  you should never be there  ==!
+         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
          !
       END SELECT

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

@@ -30 +30 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -81 +81 @@
             CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' )   ;   RETURN
          ENDIF
-         ALLOCATE( sf_ice(1)%fnow(jpi,jpj) )
-         ALLOCATE( sf_ice(1)%fdta(jpi,jpj,2) )
+         ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) )
+         IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )
 
 
@@ -107 +107 @@
                !
                zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature
-               zfr_obs = sf_ice(1)%fnow(ji,jj)              ! observed ice cover
+               zfr_obs = sf_ice(1)%fnow(ji,jj,1)            ! observed ice cover
                !                                            ! ocean ice fraction (0/1) from the freezing point temperature
                IF( sst_m(ji,jj) <= zt_fzp ) THEN   ;   fr_i(ji,jj) = 1.e0

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

@@ -5 +5 @@
    !!       &           covered area using LIM sea-ice model
    !! Sea-Ice model  :  LIM 3.0 Sea ice model time-stepping
-   !!======================================================================
-   !! History :  2.0   !  2006-12  (M. Vancoppenolle) Original code
-   !!            3.0   !  2008-02  (C. Talandier)  Surface module from icestp.F90
-   !!            9.0   !  2008-04  (G. Madec)  sltyle and lim_ctl routine
+   !!=====================================================================
+   !! History :  2.0  ! 2006-12  (M. Vancoppenolle) Original code
+   !!            3.0  ! 2008-02  (C. Talandier)  Surface module from icestp.F90
+   !!             -   ! 2008-04  (G. Madec)  sltyle and lim_ctl routine
+   !!            3.3  ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -19 +20 @@
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
-   USE c1d             ! 1d configuration
    USE dom_oce         ! ocean space and time domain
-   USE lib_mpp
+   USE lib_mpp         ! MPP library
    USE par_ice         ! sea-ice parameters
-   USE ice
-   USE iceini
-   USE dom_ice
+   USE ice             ! LIM-3: ice variables
+   USE iceini          ! LIM-3: ice initialisation
+   USE dom_ice         ! LIM-3: ice domain
 
    USE sbc_oce         ! Surface boundary condition: ocean fields
@@ -31 +31 @@
    USE sbcblk_core     ! Surface boundary condition: CORE bulk
    USE sbcblk_clio     ! Surface boundary condition: CLIO bulk
-   USE albedo
+   USE albedo          ! ocean & ice albedo
 
    USE phycst          ! Define parameters for the routines
@@ -47 +47 @@
    USE limvar          ! Ice variables switch
 
-   USE lbclnk
+   USE c1d             ! 1D vertical configuration
+   USE lbclnk          ! lateral boundary condition - MPP link
    USE iom             ! I/O manager library
    USE in_out_manager  ! I/O manager
@@ -57 +58 @@
    PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
    
-   CHARACTER(len=1) ::   cl_grid = 'C'     ! type of grid used in ice dynamics
-
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.0 , UCL-LOCEAN-IPSL  (2008)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE sbc_ice_lim( kt, kblk, kico )
+   SUBROUTINE sbc_ice_lim( kt, kblk )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ice_lim  ***
@@ -92 +90 @@
       INTEGER, INTENT(in) ::   kt      ! ocean time step
       INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE)
-      INTEGER, INTENT(in) ::   kico    ! ice-ocean stress treatment
       !!
       INTEGER  ::   jl                 ! loop index
@@ -143 +140 @@
                &                      qla_ice   , dqns_ice  , dqla_ice  ,               &
                &                      tprecip   , sprecip   ,                           &
-               &                      fr1_i0    , fr2_i0    , cl_grid, jpl  )
+               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  )
             !         
          CASE( 4 )                                       ! CORE bulk formulation
@@ -150 +147 @@
                &                      qla_ice   , dqns_ice  , dqla_ice  ,               &
                &                      tprecip   , sprecip   ,                           &
-               &                      fr1_i0    , fr2_i0    , cl_grid, jpl  )
+               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  )
          END SELECT
 
@@ -161 +158 @@
          !                                           ! Store previous ice values
 !!gm : remark   old_...   should becomes ...b  as tn versus tb  
-         old_a_i(:,:,:)   = a_i(:,:,:)     ! ice area
-         old_e_i(:,:,:,:) = e_i(:,:,:,:)   ! ice thermal energy
-         old_v_i(:,:,:)   = v_i(:,:,:)     ! ice volume
-         old_v_s(:,:,:)   = v_s(:,:,:)     ! snow volume 
-         old_e_s(:,:,:,:) = e_s(:,:,:,:)   ! snow thermal energy
-         old_smv_i(:,:,:) = smv_i(:,:,:)   ! salt content
-         old_oa_i(:,:,:)  = oa_i(:,:,:)    ! areal age content
+         old_a_i  (:,:,:)   = a_i  (:,:,:)     ! ice area
+         old_e_i  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
+         old_v_i  (:,:,:)   = v_i  (:,:,:)     ! ice volume
+         old_v_s  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
+         old_e_s  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
+         old_smv_i(:,:,:)   = smv_i(:,:,:)     ! salt content
+         old_oa_i (:,:,:)   = oa_i (:,:,:)     ! areal age content
 
          !                                           ! intialisation to zero    !!gm is it truly necessary ???
-         d_a_i_thd(:,:,:)   = 0.e0 ; d_a_i_trp(:,:,:)   = 0.e0
-         d_v_i_thd(:,:,:)   = 0.e0 ; d_v_i_trp(:,:,:)   = 0.e0
-         d_e_i_thd(:,:,:,:) = 0.e0 ; d_e_i_trp(:,:,:,:) = 0.e0
-         d_v_s_thd(:,:,:)   = 0.e0 ; d_v_s_trp(:,:,:)   = 0.e0
-         d_e_s_thd(:,:,:,:) = 0.e0 ; d_e_s_trp(:,:,:,:) = 0.e0
-         d_smv_i_thd(:,:,:) = 0.e0 ; d_smv_i_trp(:,:,:) = 0.e0
-         d_oa_i_thd(:,:,:)  = 0.e0 ; d_oa_i_trp(:,:,:)  = 0.e0
-         !
-         fseqv(:,:)     = 0.e0
-         fsbri(:,:)     = 0.e0     ; fsalt_res(:,:) = 0.e0
+         d_a_i_thd  (:,:,:)   = 0.e0   ;   d_a_i_trp  (:,:,:)   = 0.e0
+         d_v_i_thd  (:,:,:)   = 0.e0   ;   d_v_i_trp  (:,:,:)   = 0.e0
+         d_e_i_thd  (:,:,:,:) = 0.e0   ;   d_e_i_trp  (:,:,:,:) = 0.e0
+         d_v_s_thd  (:,:,:)   = 0.e0   ;   d_v_s_trp  (:,:,:)   = 0.e0
+         d_e_s_thd  (:,:,:,:) = 0.e0   ;   d_e_s_trp  (:,:,:,:) = 0.e0
+         d_smv_i_thd(:,:,:)   = 0.e0   ;   d_smv_i_trp(:,:,:)   = 0.e0
+         d_oa_i_thd (:,:,:)   = 0.e0   ;   d_oa_i_trp (:,:,:)   = 0.e0
+         !
+         fseqv    (:,:) = 0.e0
+         fsbri    (:,:) = 0.e0     ;   fsalt_res(:,:) = 0.e0
          fsalt_rpo(:,:) = 0.e0
-         fhmec(:,:)     = 0.e0     ; fhbri(:,:)     = 0.e0
-         fmmec(:,:)     = 0.e0     ; fheat_res(:,:) = 0.e0
-         fheat_rpo(:,:) = 0.e0     ; focea2D(:,:)   = 0.e0
-         fsup2D(:,:)    = 0.e0
+         fhmec    (:,:) = 0.e0     ;   fhbri    (:,:) = 0.e0
+         fmmec    (:,:) = 0.e0     ;   fheat_res(:,:) = 0.e0
+         fheat_rpo(:,:) = 0.e0     ;   focea2D  (:,:) = 0.e0
+         fsup2D   (:,:) = 0.e0
          ! 
-         diag_sni_gr(:,:) = 0.e0   ; diag_lat_gr(:,:) = 0.e0
-         diag_bot_gr(:,:) = 0.e0   ; diag_dyn_gr(:,:) = 0.e0
-         diag_bot_me(:,:) = 0.e0   ; diag_sur_me(:,:) = 0.e0
+         diag_sni_gr(:,:) = 0.e0   ;   diag_lat_gr(:,:) = 0.e0
+         diag_bot_gr(:,:) = 0.e0   ;   diag_dyn_gr(:,:) = 0.e0
+         diag_bot_me(:,:) = 0.e0   ;   diag_sur_me(:,:) = 0.e0
          ! dynamical invariants
-         delta_i(:,:) = 0.e0       ; divu_i (:,:) = 0.e0       ;    shear_i(:,:) = 0.e0
+         delta_i(:,:) = 0.e0       ;   divu_i(:,:) = 0.e0       ;   shear_i(:,:) = 0.e0
 
                           CALL lim_rst_opn( kt )     ! Open Ice restart file
@@ -196 +193 @@
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print
          !
-         IF( .NOT. lk_c1d ) THEN                     ! Ice dynamics & transport (not in 1D case)
+         IF( .NOT. lk_c1d ) THEN
+                                                     ! Ice dynamics & transport (not in 1D case)
                           CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics )
                           CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion )
@@ -204 +202 @@
                           CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting)
          ENDIF
-         !
          !                                           ! Ice thermodynamics 
                           CALL lim_var_glo2eqv            ! equivalent variables
@@ -216 +213 @@
                           CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  !
          !
-         !                                           ! Global variables update |
+         !                                           ! Global variables update
                           CALL lim_var_agg( 1 )           ! requested by limupdate
                           CALL lim_update                 ! Global variables update
@@ -223 +220 @@
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 2, ' - Final state - ' )   ! control print
          !
-         !                                           ! Fluxes of mass and heat to the ocean |
-                         CALL lim_sbc_flx( kt )           ! Ice/Ocean heat freshwater/salt fluxes
-         IF( ln_limdyn .AND. kico == 0 )   &              ! Ice/Ocean stresses (only in ice-dynamic case)
-            &            CALL lim_sbc_tau( kt, kico )     ! otherwise the atm.-ocean stresses are used everywhere
+                          CALL lim_sbc_flx( kt )     ! Update surface ocean mass, heat and salt fluxes
          !
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 3, ' - Final state lim_sbc - ' )   ! control print
@@ -239 +233 @@
          IF( ln_nicep )   CALL lim_ctl               ! alerts in case of model crash
          !
-      ENDIF                                          ! End sea-ice time step only
-
-      !                                              !--------------------------!
-      ! Ice/Ocean stresses (nn_ico_cpl=1 or 2 cases) !  at all ocean time step  !
-      !                                              !--------------------------!
-      IF( ln_limdyn .AND. kico /= 0 )   &
-         &                CALL lim_sbc_tau( kt, kico ) 
-!!gm   remark, in this case the ocean-ice stress is not saved in diag call above .....  find a solution!!!
+      ENDIF                                    ! End sea-ice time step only
+
+      !                                        !--------------------------!
+      !                                        !  at all ocean time step  !
+      !                                        !--------------------------!
+      !                                               
+      !                                              ! Update surface ocean stresses (only in ice-dynamic case)
+      !                                                   ! otherwise the atm.-ocean stresses are used everywhere
+      IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
+      
+!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
       !
    END SUBROUTINE sbc_ice_lim
@@ -664 +661 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE sbc_ice_lim ( kt, kblk, kico )     ! Dummy routine
-      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk, kico
+   SUBROUTINE sbc_ice_lim ( kt, kblk )     ! Dummy routine
+      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk
    END SUBROUTINE sbc_ice_lim
 #endif

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

@@ -2 +2 @@
    !!======================================================================
    !!                       ***  MODULE  sbcice_lim_2  ***
-   !! Surface module :  update surface ocean boundary condition over ice
-   !!                   covered area using LIM sea-ice model
-   !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
+   !! Surface module :  update surface ocean boundary condition over ice covered area using LIM sea-ice model
+   !! Sea-Ice model  :  LIM-2 Sea ice model time-stepping
    !!======================================================================
    !! History :  1.0   !  06-2006  (G. Madec)  from icestp_2.F90
    !!            3.0   !  08-2008  (S. Masson, E. .... ) coupled interface
+   !!            3.3   !  05-2009  (G.Garric) addition of the lim2_evp case
    !!----------------------------------------------------------------------
 #if defined key_lim2
    !!----------------------------------------------------------------------
-   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   sbc_ice_lim_2  : sea-ice model time-stepping and
-   !!                    update ocean sbc over ice-covered area
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE c1d             ! 1d configuration
-   USE dom_oce         ! ocean space and time domain
-   USE lib_mpp
+   !!   'key_lim2' :                                    LIM-2 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   sbc_ice_lim_2   : sea-ice model time-stepping and update ocean sbc over ice-covered area
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers
+   USE dom_oce          ! ocean space and time domain
    USE ice_2
    USE par_ice_2
@@ -25 +22 @@
    USE dom_ice_2
 
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice   fields
-   USE sbcblk_core     ! Surface boundary condition: CORE bulk
-   USE sbcblk_clio     ! Surface boundary condition: CLIO bulk
-   USE sbccpl          ! Surface boundary condition: coupled interface
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice   fields
+   USE sbcblk_core      ! Surface boundary condition: CORE bulk
+   USE sbcblk_clio      ! Surface boundary condition: CLIO bulk
+   USE sbccpl           ! Surface boundary condition: coupled interface
    USE albedo
 
-   USE phycst          ! Define parameters for the routines
-   USE eosbn2          ! equation of state
+   USE phycst           ! Define parameters for the routines
+   USE eosbn2           ! equation of state
    USE limdyn_2
    USE limtrp_2
    USE limdmp_2
    USE limthd_2
-   USE limsbc_2        ! sea surface boundary condition
+   USE limsbc_2         ! sea surface boundary condition
    USE limdia_2
    USE limwri_2
    USE limrst_2
 
-   USE lbclnk
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
+   USE c1d              ! 1D vertical configuration
+
+   USE lbclnk           ! lateral boundary condition - MPP link
+   USE lib_mpp          ! MPP library
+   USE iom              ! I/O manager library
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
 
    IMPLICIT NONE
@@ -52 +52 @@
 
    PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
-   
-   CHARACTER(len=1) ::   cl_grid = 'B'     ! type of grid used in ice dynamics
 
    !! * Substitutions
@@ -59 +57 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/SBC  3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -99 +96 @@
          IF(lwp) WRITE(numout,*) 'sbc_ice_lim_2 : update ocean surface boudary condition' 
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM) time stepping'
-
+         !
          CALL ice_init_2
-
       ENDIF
 
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-         !
+      !                                        !----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
+         !                                     !----------------------!
+         !  Bulk Formulea !
+         !----------------!
          ! ... mean surface ocean current at ice dynamics point
-         !     B-grid dynamics :  I-point 
-         DO jj = 2, jpj
-            DO ji = 2, jpi   ! B grid : no vector opt.
-               u_oce(ji,jj) = 0.5 * ( ssu_m(ji-1,jj  ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj)
-               v_oce(ji,jj) = 0.5 * ( ssv_m(ji  ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj)
+         SELECT CASE( cp_ice_msh )
+         CASE( 'I' )                  !== B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
+            DO jj = 2, jpj
+               DO ji = 2, jpi   ! NO vector opt. possible
+                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj)
+                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj)
+               END DO
             END DO
-         END DO
-         CALL lbc_lnk( u_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
-         CALL lbc_lnk( v_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
+            CALL lbc_lnk( u_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
+            CALL lbc_lnk( v_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
+            !
+         CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
+            u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point
+            v_oce(:,:) = ssv_m(:,:)
+            !
+         END SELECT
 
          ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
@@ -144 +150 @@
                &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
                &                      tprecip    , sprecip    ,                         &
-               &                      fr1_i0     , fr2_i0     , cl_grid    , jpl  )
+               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
 
          CASE( 4 )           ! CORE bulk formulation
@@ -151 +157 @@
                &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
                &                      tprecip    , sprecip    ,                         &
-               &                      fr1_i0     , fr2_i0     , cl_grid    , jpl  )
+               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
          CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
@@ -172 +178 @@
          !  Ice model step  !
          ! ---------------- !
-
-                                        CALL lim_rst_opn_2  ( kt )      ! Open Ice restart file
-         IF( .NOT. lk_c1d ) THEN                                        ! Ice dynamics & transport (not in 1D case)
-                                        CALL lim_dyn_2      ( kt )           ! Ice dynamics    ( rheology/dynamics )
-                                        CALL lim_trp_2      ( kt )           ! Ice transport   ( Advection/diffusion )
-            IF( ln_limdmp )             CALL lim_dmp_2      ( kt )           ! Ice damping 
-         ENDIF
+         numit = numit + nn_fsbc                           ! Ice model time step
+
+                           CALL lim_rst_opn_2  ( kt )  ! Open Ice restart file
+         IF( .NOT. lk_c1d ) THEN                       ! Ice dynamics & transport (except in 1D case)
+                           CALL lim_dyn_2      ( kt )      ! Ice dynamics    ( rheology/dynamics )
+                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion )
+           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping 
+         END IF
 #if defined key_coupled
-         IF( ksbc == 5    )             CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),        &
-      &                                                       qns_tot, qns_ice, qsr_tot , qsr_ice,   &
-      &                                                       emp_tot, emp_ice, dqns_ice, sprecip,   &
+         !                                             ! Ice surface fluxes in coupled mode 
+         IF( ksbc == 5 )   CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),                 &
+      &                                                   qns_tot, qns_ice, qsr_tot , qsr_ice,   &
+      &                                                   emp_tot, emp_ice, dqns_ice, sprecip,   &
       !                                      optional arguments, used only in 'mixed oce-ice' case
-      &                                                       palbi = zalb_ice_cs, psst = sst_m, pist = sist )
+      &                                                   palbi = zalb_ice_cs, psst = sst_m, pist = sist )
 #endif
-                                        CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
-                                        CALL lim_sbc_2      ( kt )      ! Ice/Ocean Mass & Heat fluxes 
+                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
+                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes 
 
          IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp )   &
-            &                           CALL lim_dia_2      ( kt )      ! Ice Diagnostics
+            &              CALL lim_dia_2      ( kt )      ! Ice Diagnostics
 # if ! defined key_iomput
-                                        CALL lim_wri_2      ( kt )      ! Ice outputs
+                           CALL lim_wri_2      ( kt )      ! Ice outputs
 # endif
-         IF( lrst_ice )                 CALL lim_rst_write_2( kt )      ! Ice restart file
+         IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file
          !
-      ENDIF
+      ENDIF                                    ! End sea-ice time step only
+      !
+      !                                        !--------------------------!
+      !                                        !  at all ocean time step  !
+      !                                        !--------------------------!
+      !                                               
+      !                                              ! Update surface ocean stresses (only in ice-dynamic case)
+      !                                                   ! otherwise the atm.-ocean stresses are used everywhere
+      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
       !
    END SUBROUTINE sbc_ice_lim_2

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

@@ -4 +4 @@
    !! Surface module :  provide to the ocean its surface boundary condition
    !!======================================================================
-   !! History :  3.0   !  07-2006  (G. Madec)  Original code
-   !!             -    !  08-2008  (S. Masson, E. .... ) coupled interface
+   !! History :  3.0  ! 2006-07  (G. Madec)  Original code
+   !!            3.1  ! 2008-08  (S. Masson, A. Caubel, E. Maisonnave, G. Madec) coupled interface
+   !!            3.3  ! 2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
+   !!            3.3  ! 2010-10  (S. Masson)  add diurnal cycle
+   !!            3.3  ! 2010-09  (D. Storkey) add ice boundary conditions (BDY)
+   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
+   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing
    !!----------------------------------------------------------------------
 
@@ -12 +17 @@
    !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE sbcssm          ! surface boundary condition: sea-surface mean variables
-   USE sbcana          ! surface boundary condition: analytical formulation
-   USE sbcflx          ! surface boundary condition: flux formulation
-   USE sbcblk_clio     ! surface boundary condition: bulk formulation : CLIO
-   USE sbcblk_core     ! surface boundary condition: bulk formulation : CORE
-   USE sbcice_if       ! surface boundary condition: ice-if sea-ice model
-   USE sbcice_lim      ! surface boundary condition: LIM 3.0 sea-ice model
-   USE sbcice_lim_2    ! surface boundary condition: LIM 2.0 sea-ice model
-   USE sbccpl          ! surface boundary condition: coupled florulation
+   USE oce              ! ocean dynamics and tracers
+   USE dom_oce          ! ocean space and time domain
+   USE phycst           ! physical constants
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE sbcdcy           ! surface boundary condition: diurnal cycle
+   USE sbcssm           ! surface boundary condition: sea-surface mean variables
+   USE sbcapr           ! surface boundary condition: atmospheric pressure
+   USE sbcana           ! surface boundary condition: analytical formulation
+   USE sbcflx           ! surface boundary condition: flux formulation
+   USE sbcblk_clio      ! surface boundary condition: bulk formulation : CLIO
+   USE sbcblk_core      ! surface boundary condition: bulk formulation : CORE
+   USE sbcice_if        ! surface boundary condition: ice-if sea-ice model
+   USE sbcice_lim       ! surface boundary condition: LIM 3.0 sea-ice model
+   USE sbcice_lim_2     ! surface boundary condition: LIM 2.0 sea-ice model
+   USE sbccpl           ! surface boundary condition: coupled florulation
    USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode?
-   USE sbcssr          ! surface boundary condition: sea surface restoring
-   USE sbcrnf          ! surface boundary condition: runoffs
-   USE sbcfwb          ! surface boundary condition: freshwater budget
-   USE closea          ! closed sea
-
-   USE prtctl          ! Print control                    (prt_ctl routine)
-   USE restart         ! ocean restart
-   USE iom
-   USE in_out_manager  ! I/O manager
+   USE sbcssr           ! surface boundary condition: sea surface restoring
+   USE sbcrnf           ! surface boundary condition: runoffs
+   USE sbcfwb           ! surface boundary condition: freshwater budget
+   USE closea           ! closed sea
+   USE bdy_par         ! unstructured open boundary data variables
+   USE bdyice          ! unstructured open boundary data  (bdy_ice_frs routine)
+
+   USE prtctl           ! Print control                    (prt_ctl routine)
+   USE restart          ! ocean restart
+   USE iom              ! IOM library
+   USE in_out_manager   ! I/O manager
 
    IMPLICIT NONE
@@ -49 +57 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -69 +76 @@
       INTEGER ::   icpt      ! temporary integer
       !!
-      NAMELIST/namsbc/ nn_fsbc, ln_ana, ln_flx, ln_blk_clio, ln_blk_core, ln_cpl,   &
-         &             nn_ice , ln_dm2dc, ln_rnf, ln_ssr, nn_fwb, nn_ico_cpl
+      NAMELIST/namsbc/ nn_fsbc, ln_ana  , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl    ,   &
+         &             ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf, ln_ssr     , nn_fwb
       !!----------------------------------------------------------------------
 
@@ -79 +86 @@
       ENDIF
 
-      REWIND( numnam )                   ! Read Namelist namsbc
+      REWIND( numnam )           ! Read Namelist namsbc
       READ  ( numnam, namsbc )
 
-      ! overwrite namelist parameter using CPP key information
-!!gm here no overwrite, test all option via namelist change: require more incore memory
-!!gm  IF( lk_sbc_cpl       ) THEN   ;   ln_cpl      = .TRUE.   ;   ELSE   ;   ln_cpl      = .FALSE.   ;   ENDIF
-
-      IF ( Agrif_Root() ) THEN
-        IF( lk_lim2 )            nn_ice      = 2
-        IF( lk_lim3 )            nn_ice      = 3
-      ENDIF
-      !
-      IF( cp_cfg == 'gyre' ) THEN
+      !                          ! overwrite namelist parameter using CPP key information
+      IF( Agrif_Root() ) THEN                ! AGRIF zoom
+        IF( lk_lim2 )   nn_ice      = 2
+        IF( lk_lim3 )   nn_ice      = 3
+      ENDIF
+      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration
           ln_ana      = .TRUE.   
           nn_ice      =   0
       ENDIF
       
-      ! Control print
-      IF(lwp) THEN
+      IF(lwp) THEN               ! Control print
          WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)'
          WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc
@@ -107 +109 @@
          WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl
          WRITE(numout,*) '           Misc. options of sbc : '
+         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn
          WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice 
-         WRITE(numout,*) '              ice-ocean stress computation (=0/1/2)      nn_ico_cpl  = ', nn_ico_cpl
          WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc 
          WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf
@@ -116 +118 @@
       ENDIF
 
+      !                          ! Checks:
       IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
          ln_rnf_mouth  = .false.                      
          nkrnf         = 0
+         rnf     (:,:) = 0.e0
          rnfmsk  (:,:) = 0.e0
          rnfmsk_z(:)   = 0.e0
@@ -138 +142 @@
          &   CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' )
       
-      ! Choice of the Surface Boudary Condition (set nsbc)
+      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag
+
+      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   &
+         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
+      
+      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   &
+         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
+      
+      !                          ! Choice of the Surface Boudary Condition (set nsbc)
       icpt = 0
       IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation
@@ -147 +159 @@
       IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation
       IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations
-
+      !
       IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
          WRITE(numout,*)
@@ -179 +191 @@
       !!                CAUTION : never mask the surface stress field (tke sbc)
       !!
-      !! ** Action  : - set the ocean surface boundary condition, i.e.  
-      !!                utau, vtau, qns, qsr, emp, emps, qrp, erp
+      !! ** Action  : - set the ocean surface boundary condition at before and now 
+      !!                time step, i.e.  
+      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, emps_b, qrp_b, erp_b
+      !!                utau  , vtau  , qns  , qsr  , emp  , emps  , qrp  , erp
       !!              - updte the ice fraction : fr_i
       !!----------------------------------------------------------------------
@@ -186 +200 @@
       !!---------------------------------------------------------------------
 
-      CALL iom_setkt( kt + nn_fsbc - 1 )         !  in sbc, iom_put is called every nn_fsbc time step
-      !
-      ! ocean to sbc mean sea surface variables (ss._m)
-      ! ---------------------------------------
-      CALL sbc_ssm( kt )                         ! sea surface mean currents (at U- and V-points), 
-      !                                          ! temperature and salinity (at T-point) over nf_sbc time-step
-      !                                          ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
-
-      ! sbc formulation
-      ! ---------------
-         
-      SELECT CASE( nsbc )                        ! Compute ocean surface boundary condition
-      !                                          ! (i.e. utau,vtau, qns, qsr, emp, emps)
+      !                                            ! ---------------------------------------- !
+      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
+         !                                         ! ---------------------------------------- !
+         utau_b(:,:) = utau(:,:)                         ! Swap the ocean forcing fields
+         vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields
+         qns_b (:,:) = qns (:,:)                         !  are set at the end of the routine)
+         ! The 3D heat content due to qsr forcing is treated in traqsr
+         ! qsr_b (:,:) = qsr (:,:)
+         emp_b (:,:) = emp (:,:)
+         emps_b(:,:) = emps(:,:)
+      ENDIF
+      !                                            ! ---------------------------------------- !
+      !                                            !        forcing field computation         !
+      !                                            ! ---------------------------------------- !
+
+      CALL iom_setkt( kt + nn_fsbc - 1 )                 ! in sbc, iom_put is called every nn_fsbc time step
+      !
+      IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
+                                                         ! (caution called before sbc_ssm)
+      !
+      CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+      !                                                  ! averaged over nf_sbc time-step
+
+                                                   !==  sbc formulation  ==!
+                                                            
+      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
+      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, emps)
       CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration
       CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc
@@ -214 +242 @@
       END SELECT
 
-      ! Misc. Options
-      ! -------------
-
-!!gm  IF( ln_dm2dc       )   CALL sbc_dcy( kt )                 ! Daily mean qsr distributed over the Diurnal Cycle
+      !                                            !==  Misc. Options  ==!
       
       SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over sea-ice areas
-      CASE(  1 )   ;       CALL sbc_ice_if   ( kt )                   ! Ice-cover climatology ("Ice-if" model)
+      CASE(  1 )   ;       CALL sbc_ice_if   ( kt )                  ! Ice-cover climatology ("Ice-if" model)
          !                                                      
-      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )             ! LIM 2.0 ice model
+      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )            ! LIM-2 ice model
+         IF( lk_bdy )      CALL bdy_ice_frs  ( kt )                  ! BDY boundary condition
          !                                                     
-      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc, nn_ico_cpl)  ! LIM 3.0 ice model
+      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc )            ! LIM-3 ice model
       END SELECT                                              
 
@@ -235 +261 @@
       IF( nclosea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain 
       !                                                         ! (update freshwater fluxes)
-      !
 !RBbug do not understand why see ticket 667
-      CALL lbc_lnk( emp, 'T', 1. )  
-      !
+      CALL lbc_lnk( emp, 'T', 1. )
+      !
+      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
+         !                                             ! ---------------------------------------- !
+         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
+            & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file'
+            CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b )   ! before i-stress  (U-point)
+            CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b )   ! before j-stress  (V-point)
+            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b  )   ! before non solar heat flux (T-point)
+            ! The 3D heat content due to qsr forcing is treated in traqsr
+            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  )   ! before     solar heat flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emp_b' , emp_b  )   ! before     freshwater flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emps_b', emps_b )   ! before C/D freshwater flux (T-point)
+         ELSE                                                   !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000'
+            utau_b(:,:) = utau(:,:) 
+            vtau_b(:,:) = vtau(:,:)
+            qns_b (:,:) = qns (:,:)
+            ! qsr_b (:,:) = qsr (:,:)
+            emp_b (:,:) = emp (:,:)
+            emps_b(:,:) = emps(:,:)
+         ENDIF
+      ENDIF
+      !                                                ! ---------------------------------------- !
+      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
+         !                                             ! ---------------------------------------- !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau )
+         CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau )
+         CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns  )
+         ! The 3D heat content due to qsr forcing is treated in traqsr
+         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  )
+         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  )
+         CALL iom_rstput( kt, nitrst, numrow, 'emps_b' , emps )
+      ENDIF
+
+      !                                                ! ---------------------------------------- !
+      !                                                !        Outputs and control print         !
+      !                                                ! ---------------------------------------- !
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-         CALL iom_put( "emp"    , emp       )                   ! upward water flux
-         CALL iom_put( "emps"   , emps      )                   ! c/d water flux
-         CALL iom_put( "qns+qsr", qns + qsr )                   ! total heat flux   (caution if ln_dm2dc=true, to be 
-         CALL iom_put( "qns"    , qns       )                   ! solar heat flux    moved after the call to iom_setkt)
-         CALL iom_put( "qsr"    ,       qsr )                   ! solar heat flux    moved after the call to iom_setkt)
-         IF(  nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )  ! ice fraction 
+         CALL iom_put( "emp-rnf" , emp  - rnf )                   ! upward water flux
+         CALL iom_put( "emps-rnf", emps - rnf )                   ! c/d water flux
+         CALL iom_put( "qns+qsr" , qns  + qsr )                   ! total heat flux 
+         CALL iom_put( "qns"     , qns        )                   ! solar heat flux
+         CALL iom_put( "qsr"     ,       qsr  )                   ! solar heat flux
+         IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
       ENDIF
       !
@@ -256 +322 @@
       !
       IF(ln_ctl) THEN         ! print mean trends (used for debugging)
-         CALL prt_ctl(tab2d_1=fr_i   , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=emp    , clinfo1=' emp  - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=emps   , clinfo1=' emps - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=qns    , clinfo1=' qns  - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=qsr    , clinfo1=' qsr  - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab3d_1=tmask  , clinfo1=' tmask  : ', mask1=tmask, ovlap=1, kdim=jpk )
-         CALL prt_ctl(tab3d_1=tn     , clinfo1=' sst  - : ', mask1=tmask, ovlap=1, kdim=1   )
-         CALL prt_ctl(tab3d_1=sn     , clinfo1=' sss  - : ', mask1=tmask, ovlap=1, kdim=1   )
-         CALL prt_ctl(tab2d_1=utau   , clinfo1=' utau - : ', mask1=umask,                      &
-            &         tab2d_2=vtau   , clinfo2=' vtau - : ', mask2=vmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=fr_i      , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emps-rnf), clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=qns       , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=qsr       , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab3d_1=tmask     , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk )
+         CALL prt_ctl(tab3d_1=tn        , clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   )
+         CALL prt_ctl(tab3d_1=sn        , clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   )
+         CALL prt_ctl(tab2d_1=utau      , clinfo1=' utau     - : ', mask1=umask,                      &
+            &         tab2d_2=vtau      , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 )
       ENDIF
       !

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

@@ -4 +4 @@
    !! Ocean forcing:  river runoff
    !!=====================================================================
-   !! History :  OPA  !  2000-11  (R. Hordoir, E. Durand)  NetCDF FORMAT
-   !!   NEMO     1.0  !  2002-09  (G. Madec)  F90: Free form and module
-   !!            3.0  !  2006-07  (G. Madec)  Surface module 
-   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put
+   !! History :  OPA  ! 2000-11  (R. Hordoir, E. Durand)  NetCDF FORMAT
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
+   !!            3.0  ! 2006-07  (G. Madec)  Surface module 
+   !!            3.2  ! 2009-04  (B. Lemaire)  Introduce iom_put
+   !!            3.3  ! 2010-10  (R. Furner, G. Madec) runoff distributed over ocean levels
    !!----------------------------------------------------------------------
 
@@ -18 +19 @@
    USE phycst          ! physical constants
    USE sbc_oce         ! surface boundary condition variables
-   USE fldread         ! ???
+   USE fldread         ! read input field at current time step
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
+   USE restart         ! restart
+   USE closea          ! closed seas
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC sbc_rnf          ! routine call in step module
-
-   !                                                     !!* namsbc_rnf namelist *
+   PUBLIC   sbc_rnf       ! routine call in sbcmod module
+   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module
+
+   !                                                      !!* namsbc_rnf namelist *
    CHARACTER(len=100), PUBLIC ::   cn_dir       = './'    !: Root directory for location of ssr files
+   LOGICAL           , PUBLIC ::   ln_rnf_depth = .false. !: depth       river runoffs attribute specified in a file
+   LOGICAL           , PUBLIC ::   ln_rnf_tem   = .false. !: temperature river runoffs attribute specified in a file 
+   LOGICAL           , PUBLIC ::   ln_rnf_sal   = .false. !: salinity    river runoffs attribute specified in a file 
    LOGICAL           , PUBLIC ::   ln_rnf_emp   = .false. !: runoffs into a file to be read or already into precipitation
    TYPE(FLD_N)       , PUBLIC ::   sn_rnf                 !: information about the runoff file to be read
    TYPE(FLD_N)       , PUBLIC ::   sn_cnf                 !: information about the runoff mouth file to be read
+   TYPE(FLD_N)                ::   sn_s_rnf               !: information about the salinities of runoff file to be read  
+   TYPE(FLD_N)                ::   sn_t_rnf               !: information about the temperatures of runoff file to be read  
+   TYPE(FLD_N)                ::   sn_dep_rnf             !: information about the depth which river inflow affects
    LOGICAL           , PUBLIC ::   ln_rnf_mouth = .false. !: specific treatment in mouths vicinity
-   REAL(wp)          , PUBLIC ::   rn_hrnf      = 0.e0    !: runoffs, depth over which enhanced vertical mixing is used
-   REAL(wp)          , PUBLIC ::   rn_avt_rnf   = 0.e0    !: runoffs, value of the additional vertical mixing coef. [m2/s]
-   REAL(wp)          , PUBLIC ::   rn_rfact     = 1.e0    !: multiplicative factor for runoff
-
-   INTEGER , PUBLIC                     ::   nkrnf = 0   !: number of levels over which Kz is increased at river mouths
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnfmsk      !: river mouth mask (hori.)
-   REAL(wp), PUBLIC, DIMENSION(jpk)     ::   rnfmsk_z    !: river mouth mask (vert.)
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf   ! structure of input SST (file information, fields read)
-
+   REAL(wp)          , PUBLIC ::   rn_hrnf      = 0._wp   !: runoffs, depth over which enhanced vertical mixing is used
+   REAL(wp)          , PUBLIC ::   rn_avt_rnf   = 0._wp   !: runoffs, value of the additional vertical mixing coef. [m2/s]
+   REAL(wp)          , PUBLIC ::   rn_rfact     = 1._wp   !: multiplicative factor for runoff
+
+   INTEGER , PUBLIC                          ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   rnfmsk            !: river mouth mask (hori.)
+   REAL(wp), PUBLIC, DIMENSION(jpk)          ::   rnfmsk_z          !: river mouth mask (vert.)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   h_rnf             !: depth of runoff in m
+   INTEGER,  PUBLIC, DIMENSION(jpi,jpj)      ::   nk_rnf            !: depth of runoff in model levels
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) :: rnf_tsc_b, rnf_tsc  !: before and now T & S contents of runoffs  [K.m/s & PSU.m/s]
+   
+   REAL(wp) ::   r1_rau0   ! = 1 / rau0 
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
+ 
+   !! * Substitutions  
+#  include "domzgr_substitute.h90"  
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -66 +84 @@
       !!
       INTEGER  ::   ji, jj   ! dummy loop indices
-      INTEGER  ::   ierror   ! temporary integer
       !!----------------------------------------------------------------------
       !                                   
-      IF( kt == nit000 ) THEN  
-         IF( .NOT. ln_rnf_emp ) THEN
-            ALLOCATE( sf_rnf(1), STAT=ierror )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN
-            ENDIF
-            ALLOCATE( sf_rnf(1)%fnow(jpi,jpj) )
-            ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,2) )
-         ENDIF
-         CALL sbc_rnf_init(sf_rnf)
+      IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures
+
+      !                                            ! ---------------------------------------- !
+      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
+         !                                         ! ---------------------------------------- !
+         rnf_b    (:,:  ) = rnf    (:,:  )               ! Swap the ocean forcing fields except at nit000
+         rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)               ! where before fields are set at the end of the routine
+         !
       ENDIF
 
@@ -85 +100 @@
          !                                                !-------------------!
          !
-         CALL fld_read( kt, nn_fsbc, sf_rnf )   ! Read Runoffs data and provides it
-         !                                      ! at the current time-step
-
+                             CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
+         IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
+         IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
+         !
          ! Runoff reduction only associated to the ORCA2_LIM configuration
          ! when reading the NetCDF file runoff_1m_nomask.nc
          IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN
+            WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
+               sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+            END WHERE
+         ENDIF
+         !
+         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )  
+            !
+            r1_rau0 = 1._wp / rau0
+            !                                                     ! set temperature & salinity content of runoffs
+            IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
+               rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+               WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999 )                 ! if missing data value use SST as runoffs temperature  
+                   rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+               END WHERE
+            ELSE                                                        ! use SST as runoffs temperature
+               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+            ENDIF  
+            !                                                           ! use runoffs salinity data 
+            IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+            !                                                           ! else use S=0 for runoffs (done one for all in the init)
+            !
+            IF( ln_rnf_tem .OR. ln_rnf_sal ) THEN                 ! runoffs as outflow: use ocean SST and SSS
+               WHERE( rnf(:,:) < 0._wp )                                 ! example baltic model when flow is out of domain 
+                  rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+                  rnf_tsc(:,:,jp_sal) = sss_m(:,:) * rnf(:,:) * r1_rau0
+               END WHERE
+            ENDIF
+            !
+            CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
+         !                                             ! ---------------------------------------- !
+         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
+            & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file'
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b )     ! before runoff
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) )   ! before heat content of runoff
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) )   ! before salinity content of runoff
+         ELSE                                                   !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000'
+             rnf_b    (:,:  ) = rnf    (:,:  )  
+             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)   
+         ENDIF
+      ENDIF
+      !                                                ! ---------------------------------------- !
+      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
+         !                                             ! ---------------------------------------- !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbcrnf : runoff forcing fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf )
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) )
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf
+
+
+   SUBROUTINE sbc_rnf_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_rnf  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the runoff inflow
+      !!
+      !! ** Method  :   
+      !!                CAUTION : rnf is positive (inflow) decreasing the 
+      !!                          divergence and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   decreased by the runoff inflow
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   r1_rau0   ! local scalar
+      REAL(wp) ::   zfact     ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zfact = 0.5_wp
+      !
+      r1_rau0 = 1._wp / rau0
+      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==!
+         IF( lk_vvl ) THEN             ! variable volume case 
+            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
+               DO ji = 1, jpi
+                  h_rnf(ji,jj) = 0._wp 
+                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
+                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box 
+                  END DO 
+                  !                          ! apply the runoff input flow
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
+                  END DO
+               END DO
+            END DO
+         ELSE                          ! constant volume case : just apply the runoff input flow
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   sf_rnf(1)%fnow(ji,jj) = 0.85 * sf_rnf(1)%fnow(ji,jj)
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
+                  END DO
                END DO
             END DO
          ENDIF
-
-         ! C a u t i o n : runoff is negative and in kg/m2/s 
-
-         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-            emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) )
-            emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) )
-            CALL iom_put( "runoffs", sf_rnf(1)%fnow )         ! runoffs
-         ENDIF
-         !
-      ENDIF
-      !
-   END SUBROUTINE sbc_rnf
-
-
-   SUBROUTINE sbc_rnf_init( sf_rnf )
+      ELSE                       !==   runoff put only at the surface   ==!
+         IF( lk_vvl ) THEN              ! variable volume case
+            h_rnf(:,:) = fse3t(:,:,1)   ! recalculate h_rnf to be depth of top box
+         ENDIF
+         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf_div
+
+
+   SUBROUTINE sbc_rnf_init
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_rnf_init  ***
@@ -121 +235 @@
       !! ** Action  : - read parameters
       !!----------------------------------------------------------------------
-      TYPE(FLD), INTENT(inout), DIMENSION(:) :: sf_rnf   ! input data
-      !!
-      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, ln_rnf_mouth,   &
-         &                 rn_hrnf, rn_avt_rnf, rn_rfact
+      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name  
+      INTEGER           ::   ji, jj, jk    ! dummy loop indices
+      INTEGER           ::   ierror, inum  ! temporary integer
+      !! 
+      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
+         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &  
+         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact  
       !!----------------------------------------------------------------------
 
@@ -136 +253 @@
       sn_cnf = FLD_N( 'runoffs',     0     , 'sorunoff' ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         )
 
+      sn_s_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
+      sn_t_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
+      sn_dep_rnf = FLD_N( 'runoffs',   0.  , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''    , ''  )  
       !
       REWIND ( numnam )                         ! Read Namelist namsbc_rnf
@@ -157 +277 @@
       !                                   ! ==================
       !
-      IF( ln_rnf_emp ) THEN                     ! runoffs directly provided in the precipitations
+      IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==!
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations'
-         !
-      ELSE                                      ! runoffs read in a file : set sf_rnf structure 
-         !
-         ! sf_rnf already allocated in main routine
-         ! fill sf_rnf with sn_rnf and control print
+         IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN
+           CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 
+           ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE.
+         ENDIF
+         !
+      ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==!
+         !
+         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow)
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file'
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   )
+         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
+         !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print
          CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
          !
-      ENDIF
-
+         IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
+            ALLOCATE( sf_t_rnf(1), STAT=ierror  )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
+            IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )  
+         ENDIF
+         !
+         IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
+            ALLOCATE( sf_s_rnf(1), STAT=ierror  )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
+            IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )  
+         ENDIF
+         !
+         IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
+            rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )  
+            CALL iom_open ( rn_dep_file, inum )                           ! open file  
+            CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array  
+            CALL iom_close( inum )                                        ! close file  
+            !
+            nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
+            DO jj = 1, jpj  
+               DO ji = 1, jpi  
+                  IF( h_rnf(ji,jj) > 0._wp ) THEN  
+                     jk = 2  
+                     DO WHILE ( jk /= mbkt(ji,jj) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO  
+                     nk_rnf(ji,jj) = jk  
+                  ELSEIF( h_rnf(ji,jj) == -1   ) THEN   ;  nk_rnf(ji,jj) = 1  
+                  ELSEIF( h_rnf(ji,jj) == -999 ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+                  ELSEIF( h_rnf(ji,jj) /=  0   ) THEN  
+                     CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )  
+                     WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj)  
+                  ENDIF  
+               END DO  
+            END DO  
+            DO jj = 1, jpj                                ! set the associated depth 
+               DO ji = 1, jpi 
+                  h_rnf(ji,jj) = 0._wp
+                  DO jk = 1, nk_rnf(ji,jj)                        
+                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)  
+                  END DO
+               END DO
+            END DO
+         ELSE                                       ! runoffs applied at the surface 
+            nk_rnf(:,:) = 1  
+            h_rnf (:,:) = fse3t(:,:,1)
+         ENDIF  
+         ! 
+      ENDIF
+      !
+      rnf_tsc(:,:,:) = 0._wp                    ! runoffs temperature & salinty contents initilisation
+      !
       !                                   ! ========================
       !                                   !   River mouth vicinity
@@ -178 +371 @@
          !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
          !
-         !                                          ! Number of level over which Kz increase
-         nkrnf = 0
-         IF( rn_hrnf > 0.e0 ) THEN
+         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
+            &                                              'be spread through depth by ln_rnf_depth'               ) 
+         !
+         nkrnf = 0                                  ! Number of level over which Kz increase
+         IF( rn_hrnf > 0._wp ) THEN
             nkrnf = 2
             DO WHILE( nkrnf /= jpkm1 .AND. gdepw_0(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO
@@ -198 +393 @@
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths'
-         rnfmsk  (:,:) = 0.e0 
-         rnfmsk_z(:)   = 0.e0
+         rnfmsk  (:,:) = 0._wp 
+         rnfmsk_z(:)   = 0._wp
          nkrnf = 0
       ENDIF
@@ -226 +421 @@
       !!                rnfmsk_z vertical structure
       !!----------------------------------------------------------------------
-      USE closea, ONLY :    clo_rnf   ! rnfmsk update routine
       !
       INTEGER           ::   inum        ! temporary integers
@@ -248 +442 @@
       IF( nclosea == 1 )    CALL clo_rnf( rnfmsk )                ! closed sea inflow set as ruver mouth
 
-      rnfmsk_z(:)   = 0.e0                                        ! vertical structure 
+      rnfmsk_z(:)   = 0._wp                                        ! vertical structure 
       rnfmsk_z(1)   = 1.0
       rnfmsk_z(2)   = 1.0                                         ! **********

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

@@ -5 +5 @@
    !!======================================================================
    !! History :  9.0   !  06-07  (G. Madec)  Original code
+   !!            3.3  ! 2010-10  (C. Bricaud, G. Madec)  add the Patm forcing for sea-ice
    !!----------------------------------------------------------------------
 
@@ -14 +15 @@
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE sbcapr          ! surface boundary condition: atmospheric pressure
    USE prtctl          ! Print control                    (prt_ctl routine)
    USE restart         ! ocean restart
@@ -27 +30 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -44 +47 @@
       !!      V-points) [m/s], temperature [Celcius] and salinity [psu] over
       !!      the periode (kt - nn_fsbc) to kt
+      !!         Note that the inverse barometer ssh (i.e. ssh associated with Patm)
+      !!      is add to ssh_m when ln_apr_dyn = T. Required for sea-ice dynamics.
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt        ! ocean time step
@@ -63 +68 @@
          sst_m(:,:) = tn(:,:,1)
          sss_m(:,:) = sn(:,:,1)
-         ssh_m(:,:) = sshn(:,:)
+         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ssh_m(:,:) = sshn(:,:)
+         ENDIF
+
          !
       ELSE
@@ -99 +108 @@
                sst_m(:,:) = zcoef * tn(:,:,1)
                sss_m(:,:) = zcoef * sn(:,:,1)
-               ssh_m(:,:) = zcoef * sshn(:,:)
+               !                          ! removed inverse barometer ssh when Patm forcing is used 
+               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
+               ELSE                    ;   ssh_m(:,:) = zcoef *   sshn(:,:)
+               ENDIF
+
             ENDIF
             !                                             ! ---------------------------------------- !
@@ -117 +130 @@
          sst_m(:,:) = sst_m(:,:) + tn(:,:,1)
          sss_m(:,:) = sss_m(:,:) + sn(:,:,1)
-         ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)
+         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 *  ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)
+         ENDIF
 
          !                                                ! ---------------------------------------- !

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

@@ -46 +46 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -115 +115 @@
                CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN
             ENDIF
-            ALLOCATE( sf_sst(1)%fnow(jpi,jpj) )
-            ALLOCATE( sf_sst(1)%fdta(jpi,jpj,2) )
+            ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) )
             !
             ! fill sf_sst with sn_sst and control print
             CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )
+            IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) )
          ENDIF
          !
@@ -128 +128 @@
                CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN
             ENDIF
-            ALLOCATE( sf_sss(1)%fnow(jpi,jpj) )
-            ALLOCATE( sf_sss(1)%fdta(jpi,jpj,2) )
+            ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) )
             !
             ! fill sf_sss with sn_sss and control print
             CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )
+            IF( sf_sss(1)%ln_tint )ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) )
          ENDIF
          !
@@ -153 +153 @@
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) )
+                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
                      qns(ji,jj) = qns(ji,jj) + zqrp
                      qrp(ji,jj) = zqrp
@@ -167 +167 @@
                   DO ji = 1, jpi
                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
+                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
                         &        / ( sss_m(ji,jj) + 1.e-20   )
                      emps(ji,jj) = emps(ji,jj) + zerp
@@ -182 +182 @@
                   DO ji = 1, jpi                            
                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
+                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
                         &        / ( sss_m(ji,jj) + 1.e-20   )
                      IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )