Changeset 4827


Ignore:
Timestamp:
2014-10-31T12:45:41+01:00 (7 years ago)
Author:
charris
Message:

Some demonstration code changes.

Location:
branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
3 added
6 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r3294 r4827  
    3434   USE in_out_manager               ! I/O manager 
    3535   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
     36   USE fld_def 
    3637 
    3738   IMPLICIT NONE 
     
    4647 
    4748   LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag 
    48    INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
    49    INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis 
    5049   INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp 
    5150   INTEGER                    ::   nerror            ! return error code 
     
    6261   END TYPE FLD_CPL 
    6362 
    64    TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   srcv, ssnd   !: Coupling fields 
     63   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   ssnd   !: Coupling fields 
    6564 
    6665   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving 
     66   INTEGER, PUBLIC :: localComm 
    6767 
    6868   !!---------------------------------------------------------------------- 
     
    106106 
    107107 
    108    SUBROUTINE cpl_prism_define( krcv, ksnd ) 
     108   SUBROUTINE cpl_prism_define( krcv, ksnd, sd ) 
    109109      !!------------------------------------------------------------------- 
    110110      !!             ***  ROUTINE cpl_prism_define  *** 
     
    115115      !! ** Method  :   OASIS3 MPI communication  
    116116      !!-------------------------------------------------------------------- 
    117       INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields 
     117      INTEGER, INTENT(in)                  ::   krcv, ksnd  ! Number of received and sent coupling fields 
     118      TYPE(FLD), INTENT(in), DIMENSION(:)  ::   sd          ! input field related variables 
    118119      ! 
    119120      INTEGER :: id_part 
     
    187188      ! 
    188189      DO ji = 1, krcv 
    189          IF ( srcv(ji)%laction ) THEN  
    190             DO jc = 1, srcv(ji)%nct 
    191                IF ( srcv(ji)%nct .gt. 1 ) THEN 
    192                   WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 
     190         IF ( sd(ji)%loasis ) THEN  
     191            DO jc = 1, sd(ji)%nct 
     192               IF ( sd(ji)%nct .gt. 1 ) THEN 
     193                  WRITE(zclname,'( a7, i1)') sd(ji)%clvar,jc 
    193194               ELSE 
    194                   zclname=srcv(ji)%clname 
     195                  zclname=sd(ji)%clvar 
    195196               ENDIF 
    196197               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 
    197                CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
     198               CALL prism_def_var_proto ( sd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
    198199                    &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
    199200               IF ( nerror /= PRISM_Ok ) THEN 
    200201                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
    201                   CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
     202                  CALL prism_abort_proto ( sd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
    202203               ENDIF 
    203204            END DO 
     
    256257 
    257258 
    258    SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo ) 
     259   SUBROUTINE cpl_prism_rcv( kstep, sd ) 
    259260      !!--------------------------------------------------------------------- 
    260261      !!              ***  ROUTINE cpl_prism_rcv  *** 
     
    263264      !!      like stresses and fluxes from the coupler or remote application. 
    264265      !!---------------------------------------------------------------------- 
    265       INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array 
    266266      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
    267       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done 
    268       INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
     267      TYPE(FLD), INTENT(inout)                  ::   sd        ! input field related variables 
    269268      !! 
    270269      INTEGER                                   ::   jc        ! local loop index 
     
    274273      ! receive local data from OASIS3 on every process 
    275274      ! 
    276       DO jc = 1, srcv(kid)%nct 
    277  
    278          CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )          
     275      DO jc = 1, sd%nct 
     276 
     277         CALL prism_get_proto ( sd%nid(jc), kstep, exfld, sd%ninfo )          
    279278          
    280279         llaction = .false. 
    281          IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
    282               kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
    283           
    284          IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 
     280         IF( sd%ninfo == PRISM_Recvd   .OR. sd%ninfo == PRISM_FromRest .OR.   & 
     281              sd%ninfo == PRISM_RecvOut .OR. sd%ninfo == PRISM_FromRestOut )   llaction = .TRUE. 
     282          
     283         IF ( ln_ctl )   WRITE(numout,*) "llaction, info, kstep, ivarid: " , llaction, sd%ninfo, kstep, sd%nid(jc) 
    285284          
    286285         IF ( llaction ) THEN 
    287286             
    288             kinfo = OASIS_Rcv 
    289             pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 
     287            sd%ninfo = OASIS_Rcv 
     288            sd%fnow(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 
    290289             
    291290            !--- Fill the overlap areas and extra hallows (mpp) 
    292291            !--- check periodicity conditions (all cases) 
    293             CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
     292            CALL lbc_lnk( sd%fnow(:,:,jc), sd%clvgrd, sd%nsgn )    
    294293             
    295294            IF ( ln_ctl ) THEN         
    296295               WRITE(numout,*) '****************' 
    297                WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
    298                WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc) 
     296               WRITE(numout,*) 'prism_get_proto: Incoming ', sd%clvar 
     297               WRITE(numout,*) 'prism_get_proto: ivarid '  , sd%nid(jc) 
    299298               WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
    300                WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
    301                WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
    302                WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
    303                WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     299               WRITE(numout,*) 'prism_get_proto:   info ', sd%ninfo 
     300               WRITE(numout,*) '     - Minimum value is ', MINVAL(sd%fnow(:,:,jc)) 
     301               WRITE(numout,*) '     - Maximum value is ', MAXVAL(sd%fnow(:,:,jc)) 
     302               WRITE(numout,*) '     -     Sum value is ', SUM(sd%fnow(:,:,jc)) 
    304303               WRITE(numout,*) '****************' 
    305304            ENDIF 
    306305             
    307306         ELSE 
    308             kinfo = OASIS_idle      
     307            sd%ninfo = OASIS_idle      
    309308         ENDIF 
    310309          
     
    346345   !!---------------------------------------------------------------------- 
    347346   USE in_out_manager               ! I/O manager 
     347   USE fld_def 
    348348   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag 
    349349   PUBLIC cpl_prism_init 
     350   PUBLIC cpl_prism_rcv 
    350351   PUBLIC cpl_prism_finalize 
    351352CONTAINS 
     
    355356      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 
    356357   END SUBROUTINE cpl_prism_init 
     358   SUBROUTINE cpl_prism_rcv ( kstep, sd ) 
     359      INTEGER, INTENT(in   )   ::   kstep     ! ocean time-step in seconds 
     360      TYPE(FLD), INTENT(inout) ::   sd        ! input field related variables 
     361      WRITE(numout,*) 'cpl_prism_rcv: Error you sould not be there...' 
     362   END SUBROUTINE cpl_prism_rcv 
    357363   SUBROUTINE cpl_prism_finalize 
    358364      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 
  • branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3772 r4827  
    2727   USE dom_oce         ! ocean space and time domain 
    2828   USE phycst          ! physical constants 
    29    USE fldread         ! read input fields 
     29   USE fldread2        ! read input fields 
     30   USE fld_def 
     31   USE sbcget 
    3032   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3133   USE cyclone         ! Cyclone 10m wind form trac of cyclone centres 
     
    4951   PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module 
    5052   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    51  
    52    INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read  
    53    INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    54    INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    55    INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( % ) 
    56    INTEGER , PARAMETER ::   jp_qsr  = 4           ! index of solar heat                      (W/m2) 
    57    INTEGER , PARAMETER ::   jp_qlw  = 5           ! index of Long wave                       (W/m2) 
    58    INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin) 
    59    INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
    60    INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    61    INTEGER , PARAMETER ::   jp_tdif = 9           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
    6253    
    63    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
     54   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr 
    6455          
    6556   !                                             !!! CORE bulk parameters 
     
    119110      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    120111      !! 
    121       INTEGER  ::   ierror   ! return error code 
    122       INTEGER  ::   ifpr     ! dummy loop indice 
    123       INTEGER  ::   jfld     ! dummy loop arguments 
    124       !! 
    125       CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files 
    126       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read 
    127       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr             ! informations about the fields to be read 
    128       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif   !       -                       - 
    129       NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           & 
    130          &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    131          &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif 
     112!      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           & 
     113!         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
     114!         &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif 
    132115      !!--------------------------------------------------------------------- 
    133116 
     
    135118      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    136119         !                                      ! ====================== ! 
    137          ! set file information (default values) 
    138          cn_dir = './'       ! directory in which the model is executed 
    139120         ! 
    140          ! (NB: frequency positive => hours, negative => months) 
    141          !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
    142          !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
    143          sn_wndi = FLD_N( 'uwnd10m',    24     , 'u_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    144          sn_wndj = FLD_N( 'vwnd10m',    24     , 'v_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    145          sn_qsr  = FLD_N( 'qsw'    ,    24     , 'qsw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    146          sn_qlw  = FLD_N( 'qlw'    ,    24     , 'qlw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    147          sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    148          sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
    149          sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
    150          sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
    151          sn_tdif = FLD_N( 'taudif' ,    24     , 'taudif' ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
    152          ! 
    153          REWIND( numnam )                          ! read in namlist namsbc_core 
    154          READ  ( numnam, namsbc_core ) 
    155121         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    156          IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &  
     122         IF( ln_dm2dc .AND. sf(jp_qsroce)%nfreqh /= 24 )   &  
    157123            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )  
    158          IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN 
     124         IF( ln_dm2dc .AND. sf(jp_qsroce)%ln_tint ) THEN 
    159125            CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   & 
    160126                 &         '              ==> We force time interpolation = .false. for qsr' ) 
    161             sn_qsr%ln_tint = .false. 
     127            sf(jp_qsroce)%ln_tint = .false. 
    162128         ENDIF 
    163          !                                         ! store namelist information in an array 
    164          slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj 
    165          slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw 
    166          slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    167          slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    168          slf_i(jp_tdif) = sn_tdif 
    169129         !                  
    170130         lhftau = ln_taudif                        ! do we use HF tau information? 
    171          jfld = jpfld - COUNT( (/.NOT. lhftau/) ) 
    172          ! 
    173          ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure 
    174          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_core: unable to allocate sf structure' ) 
    175          DO ifpr= 1, jfld 
    176             ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    177             IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    178          END DO 
    179          !                                         ! fill sf with slf_i and control print 
    180          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' ) 
    181131         ! 
    182132         sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 
    183133         ! 
    184134      ENDIF 
    185  
    186       CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
    187  
    188135      !                                            ! compute the surface ocean fluxes using CORE bulk formulea 
    189136      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 
     
    192139      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
    193140         qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1)  
    194          qsr_ice(:,:,1)   = sf(jp_qsr)%fnow(:,:,1) 
     141         qsr_ice(:,:,1)   = sf(jp_qsroce)%fnow(:,:,1) 
    195142         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)          
    196143         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
     
    298245      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave 
    299246      zztmp = 1. - albo 
    300       IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
    301       ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
     247      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsroce)%fnow(:,:,1) ) * tmask(:,:,1) 
     248      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsroce)%fnow(:,:,1)   * tmask(:,:,1) 
    302249      ENDIF 
    303250!CDIR COLLAPSE 
  • branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r3680 r4827  
    2626   USE sbcdcy          ! surface boundary condition: diurnal cycle 
    2727   USE phycst          ! physical constants 
     28   USE fldread2, ONLY: fld_fill2           ! read input fields 
     29   USE fld_def 
     30   USE sbcget 
    2831#if defined key_lim3 
    2932   USE par_ice         ! ice parameters 
     
    5356#endif 
    5457   USE diaar5, ONLY :   lk_diaar5 
    55 #if defined key_cice 
    56    USE ice_domain_size, only: ncat 
    57 #endif 
     58 
    5859   IMPLICIT NONE 
    5960   PRIVATE 
     
    6364   PUBLIC   sbc_cpl_ice_tau    ! routine called by sbc_ice_lim(_2).F90 
    6465   PUBLIC   sbc_cpl_ice_flx    ! routine called by sbc_ice_lim(_2).F90 
    65  
    66    INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1 
    67    INTEGER, PARAMETER ::   jpr_oty1   =  2            !  
    68    INTEGER, PARAMETER ::   jpr_otz1   =  3            !  
    69    INTEGER, PARAMETER ::   jpr_otx2   =  4            ! 3 atmosphere-ocean stress components on grid 2 
    70    INTEGER, PARAMETER ::   jpr_oty2   =  5            !  
    71    INTEGER, PARAMETER ::   jpr_otz2   =  6            !  
    72    INTEGER, PARAMETER ::   jpr_itx1   =  7            ! 3 atmosphere-ice   stress components on grid 1 
    73    INTEGER, PARAMETER ::   jpr_ity1   =  8            !  
    74    INTEGER, PARAMETER ::   jpr_itz1   =  9            !  
    75    INTEGER, PARAMETER ::   jpr_itx2   = 10            ! 3 atmosphere-ice   stress components on grid 2 
    76    INTEGER, PARAMETER ::   jpr_ity2   = 11            !  
    77    INTEGER, PARAMETER ::   jpr_itz2   = 12            !  
    78    INTEGER, PARAMETER ::   jpr_qsroce = 13            ! Qsr above the ocean 
    79    INTEGER, PARAMETER ::   jpr_qsrice = 14            ! Qsr above the ice 
    80    INTEGER, PARAMETER ::   jpr_qsrmix = 15  
    81    INTEGER, PARAMETER ::   jpr_qnsoce = 16            ! Qns above the ocean 
    82    INTEGER, PARAMETER ::   jpr_qnsice = 17            ! Qns above the ice 
    83    INTEGER, PARAMETER ::   jpr_qnsmix = 18 
    84    INTEGER, PARAMETER ::   jpr_rain   = 19            ! total liquid precipitation (rain) 
    85    INTEGER, PARAMETER ::   jpr_snow   = 20            ! solid precipitation over the ocean (snow) 
    86    INTEGER, PARAMETER ::   jpr_tevp   = 21            ! total evaporation 
    87    INTEGER, PARAMETER ::   jpr_ievp   = 22            ! solid evaporation (sublimation) 
    88    INTEGER, PARAMETER ::   jpr_sbpr   = 23            ! sublimation - liquid precipitation - solid precipitation 
    89    INTEGER, PARAMETER ::   jpr_semp   = 24            ! solid freshwater budget (sublimation - snow) 
    90    INTEGER, PARAMETER ::   jpr_oemp   = 25            ! ocean freshwater budget (evap - precip) 
    91    INTEGER, PARAMETER ::   jpr_w10m   = 26            ! 10m wind 
    92    INTEGER, PARAMETER ::   jpr_dqnsdt = 27            ! d(Q non solar)/d(temperature) 
    93    INTEGER, PARAMETER ::   jpr_rnf    = 28            ! runoffs 
    94    INTEGER, PARAMETER ::   jpr_cal    = 29            ! calving 
    95    INTEGER, PARAMETER ::   jpr_taum   = 30            ! wind stress module 
    96    INTEGER, PARAMETER ::   jpr_co2    = 31 
    97    INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
    98    INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
    99    INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
    10066 
    10167   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
     
    12490      CHARACTER(len = 32) ::   clvgrd                 ! grids on which is located the vector fields 
    12591   END TYPE FLD_C 
     92 
     93 
    12694   ! Send to the atmosphere                           ! 
    12795   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                         
     
    12997   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    13098   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
    131  
    132    TYPE ::   DYNARR      
    133       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
    134    END TYPE DYNARR 
    135  
    136    TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                      ! all fields recieved from the atmosphere 
     99   TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_otx1, sn_oty1, sn_otz1, sn_otx2, sn_oty2, sn_otz2,  sn_itx1, sn_ity1, sn_itz1, sn_itx2, sn_ity2, sn_itz2 
    137100 
    138101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
    139  
    140    INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    141102 
    142103#if ! defined key_lim2   &&   ! defined key_lim3 
     
    145106#endif 
    146107 
    147 #if defined key_cice 
    148    INTEGER, PARAMETER ::   jpl = ncat 
    149 #elif ! defined key_lim2   &&   ! defined key_lim3 
    150    INTEGER, PARAMETER ::   jpl = 1  
     108#if ! defined key_cice  && ! defined key_lim2   &&   ! defined key_lim3 
    151109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
    152110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
     
    183141      ierr(:) = 0 
    184142      ! 
    185       ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 
     143      ALLOCATE( albedo_oce_mix(jpi,jpj), STAT=ierr(1) ) 
    186144      ! 
    187145#if ! defined key_lim2 && ! defined key_lim3 
     
    220178      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    221179      !! 
    222       INTEGER ::   jn   ! dummy loop index 
     180      INTEGER ::   jn       ! dummy loop index 
    223181      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos 
    224182      !! 
     
    297255      !   Define the receive interface   ! 
    298256      ! ================================ ! 
    299       nrcvinfo(:) = OASIS_idle   ! needed by nrcvinfo(jpr_otx1) if we do not receive ocean stress  
    300  
    301       ! for each field: define the OASIS name                              (srcv(:)%clname) 
    302       !                 define receive or not from the namelist parameters (srcv(:)%laction) 
    303       !                 define the north fold type of lbc                  (srcv(:)%nsgn) 
    304  
    305       ! default definitions of srcv 
    306       srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1 
    307  
    308       !                                                      ! ------------------------- ! 
    309       !                                                      ! ice and ocean wind stress !    
    310       !                                                      ! ------------------------- ! 
    311       !                                                           ! Name  
    312       srcv(jpr_otx1)%clname = 'O_OTaux1'      ! 1st ocean component on grid ONE (T or U) 
    313       srcv(jpr_oty1)%clname = 'O_OTauy1'      ! 2nd   -      -         -     -  
    314       srcv(jpr_otz1)%clname = 'O_OTauz1'      ! 3rd   -      -         -     -  
    315       srcv(jpr_otx2)%clname = 'O_OTaux2'      ! 1st ocean component on grid TWO (V) 
    316       srcv(jpr_oty2)%clname = 'O_OTauy2'      ! 2nd   -      -         -     -  
    317       srcv(jpr_otz2)%clname = 'O_OTauz2'      ! 3rd   -      -         -     -  
    318       ! 
    319       srcv(jpr_itx1)%clname = 'O_ITaux1'      ! 1st  ice  component on grid ONE (T, F, I or U) 
    320       srcv(jpr_ity1)%clname = 'O_ITauy1'      ! 2nd   -      -         -     -  
    321       srcv(jpr_itz1)%clname = 'O_ITauz1'      ! 3rd   -      -         -     -  
    322       srcv(jpr_itx2)%clname = 'O_ITaux2'      ! 1st  ice  component on grid TWO (V) 
    323       srcv(jpr_ity2)%clname = 'O_ITauy2'      ! 2nd   -      -         -     -  
    324       srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     -  
    325       !  
     257 
    326258      ! Vectors: change of sign at north fold ONLY if on the local grid 
    327       IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
     259      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   sf(jp_otx1:jp_itz2)%nsgn = -1. 
    328260       
    329       !                                                           ! Set grid and action 
    330       SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 
    331       CASE( 'T' )  
    332          srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    333          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    334          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
    335       CASE( 'U,V' )  
    336          srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point 
    337          srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    338          srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point 
    339          srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point 
    340          srcv(jpr_otx1:jpr_itz2)%laction = .TRUE.     ! receive oce and ice components on both grid 1 & 2 
    341       CASE( 'U,V,T' ) 
    342          srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point 
    343          srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    344          srcv(jpr_itx1:jpr_itz1)%clgrid  = 'T'        ! ice components given at T-point 
    345          srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
    346          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    347       CASE( 'U,V,I' ) 
    348          srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point 
    349          srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    350          srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point 
    351          srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
    352          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    353       CASE( 'U,V,F' ) 
    354          srcv(jpr_otx1:jpr_otz1)%clgrid  = 'U'        ! oce components given at U-point 
    355          srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    356          srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    357          srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
    358          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    359       CASE( 'T,I' )  
    360          srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    361          srcv(jpr_itx1:jpr_itz1)%clgrid  = 'I'        ! ice components given at I-point 
    362          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    363          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
    364       CASE( 'T,F' )  
    365          srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    366          srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    367          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1  
    368          srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1  
    369       CASE( 'T,U,V' ) 
    370          srcv(jpr_otx1:jpr_otz1)%clgrid  = 'T'        ! oce components given at T-point 
    371          srcv(jpr_itx1:jpr_itz1)%clgrid  = 'U'        ! ice components given at U-point 
    372          srcv(jpr_itx2:jpr_itz2)%clgrid  = 'V'        !           and           V-point 
    373          srcv(jpr_otx1:jpr_otz1)%laction = .TRUE.     ! receive oce components on grid 1 only 
    374          srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2 
    375       CASE default    
    376          CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 
    377       END SELECT 
    378       ! 
    379       IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' )   &           ! spherical: 3rd component not received 
    380          &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.  
    381261      ! 
    382262      IF( TRIM( sn_rcv_tau%clvor  ) == 'local grid' ) THEN        ! already on local grid -> no need of the second grid 
    383             srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.  
    384             srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.  
    385             srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid   ! not needed but cleaner... 
    386             srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid   ! not needed but cleaner... 
    387       ENDIF 
    388       ! 
    389       IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used 
    390          srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received 
    391          srcv(jpr_itx1)%clgrid = 'U'                  ! ocean stress used after its transformation 
    392          srcv(jpr_ity1)%clgrid = 'V'                  ! i.e. it is always at U- & V-points for i- & j-comp. resp. 
    393       ENDIF 
    394         
    395       !                                                      ! ------------------------- ! 
    396       !                                                      !    freshwater budget      !   E-P 
    397       !                                                      ! ------------------------- ! 
    398       ! we suppose that atmosphere modele do not make the difference between precipiration (liquide or solid) 
    399       ! over ice of free ocean within the same atmospheric cell.cd  
    400       srcv(jpr_rain)%clname = 'OTotRain'      ! Rain = liquid precipitation 
    401       srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation 
    402       srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation) 
    403       srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation 
    404       srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation  
    405       srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation 
    406       srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    407       SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    408       CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    409       CASE( 'conservative'  )   ;   srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
    410       CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 
    411       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 
    412       END SELECT 
    413  
    414       !                                                      ! ------------------------- ! 
    415       !                                                      !     Runoffs & Calving     !    
    416       !                                                      ! ------------------------- ! 
    417       srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
    418 ! This isn't right - really just want ln_rnf_emp changed 
    419 !                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    420 !                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
    421 !                                                 ENDIF 
    422       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    423  
    424       !                                                      ! ------------------------- ! 
    425       !                                                      !    non solar radiation    !   Qns 
    426       !                                                      ! ------------------------- ! 
    427       srcv(jpr_qnsoce)%clname = 'O_QnsOce' 
    428       srcv(jpr_qnsice)%clname = 'O_QnsIce' 
    429       srcv(jpr_qnsmix)%clname = 'O_QnsMix' 
    430       SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 
    431       CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE. 
    432       CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
    433       CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 
    434       CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE.  
    435       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 
    436       END SELECT 
    437       IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
    438          CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
    439       !                                                      ! ------------------------- ! 
    440       !                                                      !    solar radiation        !   Qsr 
    441       !                                                      ! ------------------------- ! 
    442       srcv(jpr_qsroce)%clname = 'O_QsrOce' 
    443       srcv(jpr_qsrice)%clname = 'O_QsrIce' 
    444       srcv(jpr_qsrmix)%clname = 'O_QsrMix' 
    445       SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 
    446       CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE. 
    447       CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
    448       CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 
    449       CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE.  
    450       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 
    451       END SELECT 
    452       IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
    453          CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
    454       !                                                      ! ------------------------- ! 
    455       !                                                      !   non solar sensitivity   !   d(Qns)/d(T) 
    456       !                                                      ! ------------------------- ! 
    457       srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'    
    458       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE. 
    459       ! 
    460       ! non solar sensitivity mandatory for LIM ice model 
    461       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 
    462          CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    463       ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
    464       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 
    465          CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 
    466       !                                                      ! ------------------------- ! 
    467       !                                                      !    Ice Qsr penetration    !    
    468       !                                                      ! ------------------------- ! 
    469       ! fraction of net shortwave radiation which is not absorbed in the thin surface layer  
    470       ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    471       ! Coupled case: since cloud cover is not received from atmosphere  
    472       !               ===> defined as constant value -> definition done in sbc_cpl_init 
    473       fr1_i0(:,:) = 0.18 
    474       fr2_i0(:,:) = 0.82 
    475       !                                                      ! ------------------------- ! 
    476       !                                                      !      10m wind module      !    
    477       !                                                      ! ------------------------- ! 
    478       srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE.  
    479       ! 
    480       !                                                      ! ------------------------- ! 
    481       !                                                      !   wind stress module      !    
    482       !                                                      ! ------------------------- ! 
    483       srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
    484       lhftau = srcv(jpr_taum)%laction 
    485  
    486       !                                                      ! ------------------------- ! 
    487       !                                                      !      Atmospheric CO2      ! 
    488       !                                                      ! ------------------------- ! 
    489       srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
    490       !                                                      ! ------------------------- ! 
    491       !                                                      !   topmelt and botmelt     !    
    492       !                                                      ! ------------------------- ! 
    493       srcv(jpr_topm )%clname = 'OTopMlt' 
    494       srcv(jpr_botm )%clname = 'OBotMlt' 
    495       IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 
    496          IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
    497             srcv(jpr_topm:jpr_botm)%nct = jpl 
    498          ELSE 
    499             CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 
    500          ENDIF 
    501          srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    502       ENDIF 
    503  
    504       ! Allocate all parts of frcv used for received fields 
    505       DO jn = 1, jprcv 
    506          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    507       END DO 
    508       ! Allocate taum part of frcv which is used even when not received as coupling field 
    509       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 
     263            sf(jp_oty1)%clvgrd = sf(jp_oty2)%clvgrd   ! not needed but cleaner... 
     264            sf(jp_ity1)%clvgrd = sf(jp_ity2)%clvgrd   ! not needed but cleaner... 
     265      ENDIF 
     266      ! 
    510267 
    511268      ! ================================ ! 
     
    621378      ! ================================ ! 
    622379 
    623       CALL cpl_prism_define(jprcv, jpsnd)             
    624       ! 
    625       IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   & 
     380      CALL cpl_prism_define(jpfld, jpsnd, sf)             
     381      ! 
     382      IF( ln_dm2dc .AND. ( cpl_prism_freq( jp_qsroce ) + cpl_prism_freq( jp_qsrmix ) /= 86400 ) )   & 
    626383         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    627384 
     
    640397      !!                provide the ocean heat and freshwater fluxes. 
    641398      !! 
    642       !! ** Method  : - Receive all the atmospheric fields (stored in frcv array). called at each time step. 
    643       !!                OASIS controls if there is something do receive or not. nrcvinfo contains the info 
     399      !! ** Method  : - Receive all the atmospheric fields (stored in sf array). called at each time step. 
     400      !!                OASIS controls if there is something do receive or not. ninfo contains the info 
    644401      !!                to know if the field was really received or not 
    645402      !! 
     
    683440      LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module?? 
    684441      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    685       INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
    686442      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    687443      REAL(wp) ::   zcoef                  ! temporary scalar 
     
    699455 
    700456      !                                                 ! Receive all the atmos. fields (including ice information) 
    701       isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    702       DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    703          IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 
    704       END DO 
    705  
    706457      !                                                      ! ========================= ! 
    707       IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  ! 
     458      IF( sf(jp_otx1)%loasis ) THEN                      !  ocean stress components  ! 
    708459         !                                                   ! ========================= ! 
    709          ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid 
     460         ! define sf(jp_otx1)%fnow(:,:,1) and sf(jp_oty1)%fnow(:,:,1): stress at U/V point along model grid 
    710461         ! => need to be done only when we receive the field 
    711          IF(  nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN 
     462         IF(  sf(jp_otx1)%ninfo == OASIS_Rcv ) THEN 
    712463            ! 
    713464            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    714465               !                                                       ! (cartesian to spherical -> 3 to 2 components) 
    715466               ! 
    716                CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1),   & 
    717                   &          srcv(jpr_otx1)%clgrid, ztx, zty ) 
    718                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
    719                frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
     467               CALL geo2oce( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otz1)%fnow(:,:,1),   & 
     468                  &          sf(jp_otx1)%clvgrd, ztx, zty ) 
     469               sf(jp_otx1)%fnow(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
     470               sf(jp_oty1)%fnow(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
    720471               ! 
    721                IF( srcv(jpr_otx2)%laction ) THEN 
    722                   CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1),   & 
    723                      &          srcv(jpr_otx2)%clgrid, ztx, zty ) 
    724                   frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
    725                   frcv(jpr_oty2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
     472               IF( sf(jp_otx2)%loasis ) THEN 
     473                  CALL geo2oce( sf(jp_otx2)%fnow(:,:,1), sf(jp_oty2)%fnow(:,:,1), sf(jp_otz2)%fnow(:,:,1),   & 
     474                     &          sf(jp_otx2)%clvgrd, ztx, zty ) 
     475                  sf(jp_otx2)%fnow(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
     476                  sf(jp_oty2)%fnow(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
    726477               ENDIF 
    727478               ! 
     
    730481            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    731482               !                                                       ! (geographical to local grid -> rotate the components) 
    732                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    733                IF( srcv(jpr_otx2)%laction ) THEN 
    734                   CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     483               CALL rot_rep( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otx1)%clvgrd, 'en->i', ztx )    
     484               IF( sf(jp_otx2)%loasis ) THEN 
     485                  CALL rot_rep( sf(jp_otx2)%fnow(:,:,1), sf(jp_oty2)%fnow(:,:,1), sf(jp_otx2)%clvgrd, 'en->j', zty )    
    735486               ELSE   
    736                   CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     487                  CALL rot_rep( sf(jp_otx1)%fnow(:,:,1), sf(jp_oty1)%fnow(:,:,1), sf(jp_otx1)%clvgrd, 'en->j', zty )   
    737488               ENDIF 
    738                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    739                frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
     489               sf(jp_otx1)%fnow(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     490               sf(jp_oty1)%fnow(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    740491            ENDIF 
    741492            !                               
    742             IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 
     493            IF( sf(jp_otx1)%clvgrd == 'T' ) THEN 
    743494               DO jj = 2, jpjm1                                          ! T ==> (U,V) 
    744495                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    745                      frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 
    746                      frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 
    747                   END DO 
    748                END DO 
    749                CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U',  -1. )   ;   CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. ) 
     496                     sf(jp_otx1)%fnow(ji,jj,1) = 0.5 * ( sf(jp_otx1)%fnow(ji+1,jj  ,1) + sf(jp_otx1)%fnow(ji,jj,1) ) 
     497                     sf(jp_oty1)%fnow(ji,jj,1) = 0.5 * ( sf(jp_oty1)%fnow(ji  ,jj+1,1) + sf(jp_oty1)%fnow(ji,jj,1) ) 
     498                  END DO 
     499               END DO 
     500               CALL lbc_lnk( sf(jp_otx1)%fnow(:,:,1), 'U',  -1. )   ;   CALL lbc_lnk( sf(jp_oty1)%fnow(:,:,1), 'V',  -1. ) 
    750501            ENDIF 
    751502            llnewtx = .TRUE. 
     
    756507      ELSE                                                   !   No dynamical coupling   ! 
    757508         !                                                   ! ========================= ! 
    758          frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero  
    759          frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead 
     509         sf(jp_otx1)%fnow(:,:,1) = 0.e0                               ! here simply set to zero  
     510         sf(jp_oty1)%fnow(:,:,1) = 0.e0                               ! an external read in a file can be added instead 
    760511         llnewtx = .TRUE. 
    761512         ! 
     
    766517      !                                                      ! ========================= ! 
    767518      ! 
    768       IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received  
     519      IF( .NOT. sf(jp_taum)%loasis ) THEN                    ! compute wind stress module from its components if not received  
    769520         ! => need to be done only when otx1 was changed 
    770521         IF( llnewtx ) THEN 
     
    773524!CDIR NOVERRCHK 
    774525               DO ji = fs_2, fs_jpim1   ! vect. opt. 
    775                   zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 
    776                   zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 
    777                   frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 
     526                  zzx = sf(jp_otx1)%fnow(ji-1,jj  ,1) + sf(jp_otx1)%fnow(ji,jj,1) 
     527                  zzy = sf(jp_oty1)%fnow(ji  ,jj-1,1) + sf(jp_oty1)%fnow(ji,jj,1) 
     528                  sf(jp_taum)%fnow(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 
    778529               END DO 
    779530            END DO 
    780             CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 
     531            CALL lbc_lnk( sf(jp_taum)%fnow(:,:,1), 'T', 1. ) 
    781532            llnewtau = .TRUE. 
    782533         ELSE 
     
    784535         ENDIF 
    785536      ELSE 
    786          llnewtau = nrcvinfo(jpr_taum) == OASIS_Rcv 
     537         llnewtau = sf(jp_taum)%ninfo == OASIS_Rcv 
    787538         ! Stress module can be negative when received (interpolation problem) 
    788539         IF( llnewtau ) THEN  
    789             frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) ) 
     540            sf(jp_taum)%fnow(:,:,1) = MAX( 0._wp, sf(jp_taum)%fnow(:,:,1) ) 
    790541         ENDIF 
    791542      ENDIF 
     
    795546      !                                                      ! ========================= ! 
    796547      ! 
    797       IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received   
     548      IF( .NOT. sf(jp_w10m)%loasis ) THEN                    ! compute wind spreed from wind stress module if not received   
    798549         ! => need to be done only when taumod was changed 
    799550         IF( llnewtau ) THEN  
     
    803554!CDIR NOVERRCHK 
    804555               DO ji = 1, jpi  
    805                   wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
     556                  wndm(ji,jj) = SQRT( sf(jp_taum)%fnow(ji,jj,1) * zcoef ) 
    806557               END DO 
    807558            END DO 
    808559         ENDIF 
    809560      ELSE 
    810          IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
     561         IF ( sf(jp_w10m)%ninfo == OASIS_Rcv ) wndm(:,:) = sf(jp_w10m)%fnow(:,:,1) 
    811562      ENDIF 
    812563 
     
    815566      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    816567         ! 
    817          utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
    818          vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
    819          taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     568         utau(:,:) = sf(jp_otx1)%fnow(:,:,1) 
     569         vtau(:,:) = sf(jp_oty1)%fnow(:,:,1) 
     570         taum(:,:) = sf(jp_taum)%fnow(:,:,1) 
    820571         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    821572         !   
     
    824575#if defined key_cpl_carbon_cycle 
    825576      !                                                              ! atmosph. CO2 (ppm) 
    826       IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
     577      IF( sf(jp_co2)%loasis )   atm_co2(:,:) = sf(jp_co2)%fnow(:,:,1) 
    827578#endif 
    828579 
     
    834585         SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    835586         CASE( 'conservative' ) 
    836             emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
     587            emp(:,:) = sf(jp_tevp)%fnow(:,:,1) - ( sf(jp_rain)%fnow(:,:,1) + sf(jp_snow)%fnow(:,:,1) ) 
    837588         CASE( 'oce only', 'oce and ice' ) 
    838             emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
     589            emp(:,:) = sf(jp_oemp)%fnow(:,:,1) 
    839590         CASE default 
    840591            CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
     
    842593         ! 
    843594         !                                                        ! runoffs and calving (added in emp) 
    844          IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    845          IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     595         IF( sf(jp_rnf)%loasis )   emp(:,:) = emp(:,:) - sf(jp_rnf)%fnow(:,:,1) 
     596         IF( sf(jp_cal)%loasis )   emp(:,:) = emp(:,:) - sf(jp_cal)%fnow(:,:,1) 
    846597         ! 
    847598!!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
     
    849600!!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    850601!!            ! remove negative runoff 
    851 !!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    852 !!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
     602!!            zcumulpos = SUM( MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
     603!!            zcumulneg = SUM( MIN( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    853604!!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    854605!!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    855606!!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points 
    856607!!               zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    857 !!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
     608!!               sf(jp_rnf)%fnow(:,:,1) = MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * zcumulneg 
    858609!!            ENDIF      
    859610!!            ! add runoff to e-p  
    860 !!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
     611!!            emp(:,:) = emp(:,:) - sf(jp_rnf)%fnow(:,:,1) 
    861612!!         ENDIF 
    862613!!gm  end of internal cooking 
    863614         ! 
    864615         !                                                       ! non solar heat flux over the ocean (qns) 
    865          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    866          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     616         IF( sf(jp_qnsoce)%loasis )   qns(:,:) = sf(jp_qnsoce)%fnow(:,:,1) 
     617         IF( sf(jp_qnsmix)%loasis )   qns(:,:) = sf(jp_qnsmix)%fnow(:,:,1) 
    867618         ! add the latent heat of solid precip. melting 
    868          IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with: 
    869               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean 
     619         IF( sf(jp_snow  )%loasis )   THEN                         ! update qns over the free ocean with: 
     620              qns(:,:) = qns(:,:) - sf(jp_snow)%fnow(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean 
    870621           &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST) 
    871622         ENDIF 
    872623 
    873624         !                                                       ! solar flux over the ocean          (qsr) 
    874          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
    875          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
     625         IF( sf(jp_qsroce)%loasis )   qsr(:,:) = sf(jp_qsroce)%fnow(:,:,1) 
     626         IF( sf(jp_qsrmix)%loasis )   qsr(:,:) = sf(jp_qsrmix)%fnow(:,:,1) 
    876627         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
    877628         ! 
     
    931682      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    932683 
    933       IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    934       ELSE                                ;   itx =  jpr_otx1 
     684      IF( sf(jp_itx1)%loasis ) THEN   ;   itx =  jp_itx1    
     685      ELSE                                ;   itx =  jp_otx1 
    935686      ENDIF 
    936687 
    937688      ! do something only if we just received the stress from atmosphere 
    938       IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN 
     689      IF(  sf(itx)%ninfo == OASIS_Rcv ) THEN 
    939690 
    940691         !                                                      ! ======================= ! 
    941          IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
     692         IF( sf(jp_itx1)%loasis ) THEN                      !   ice stress received   ! 
    942693            !                                                   ! ======================= ! 
    943694            !   
    944695            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    945696               !                                                       ! (cartesian to spherical -> 3 to 2 components) 
    946                CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   & 
    947                   &          srcv(jpr_itx1)%clgrid, ztx, zty ) 
    948                frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
    949                frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
     697               CALL geo2oce(  sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itz1)%fnow(:,:,1),   & 
     698                  &          sf(jp_itx1)%clvgrd, ztx, zty ) 
     699               sf(jp_itx1)%fnow(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
     700               sf(jp_ity1)%fnow(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
    950701               ! 
    951                IF( srcv(jpr_itx2)%laction ) THEN 
    952                   CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   & 
    953                      &          srcv(jpr_itx2)%clgrid, ztx, zty ) 
    954                   frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
    955                   frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
     702               IF( sf(jp_itx2)%loasis ) THEN 
     703                  CALL geo2oce( sf(jp_itx2)%fnow(:,:,1), sf(jp_ity2)%fnow(:,:,1), sf(jp_itz2)%fnow(:,:,1),   & 
     704                     &          sf(jp_itx2)%clvgrd, ztx, zty ) 
     705                  sf(jp_itx2)%fnow(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
     706                  sf(jp_ity2)%fnow(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
    956707               ENDIF 
    957708               ! 
     
    960711            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    961712               !                                                       ! (geographical to local grid -> rotate the components) 
    962                CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )    
    963                IF( srcv(jpr_itx2)%laction ) THEN 
    964                   CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )    
     713               CALL rot_rep( sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itx1)%clvgrd, 'en->i', ztx )    
     714               IF( sf(jp_itx2)%loasis ) THEN 
     715                  CALL rot_rep( sf(jp_itx2)%fnow(:,:,1), sf(jp_ity2)%fnow(:,:,1), sf(jp_itx2)%clvgrd, 'en->j', zty )    
    965716               ELSE 
    966                   CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )   
     717                  CALL rot_rep( sf(jp_itx1)%fnow(:,:,1), sf(jp_ity1)%fnow(:,:,1), sf(jp_itx1)%clvgrd, 'en->j', zty )   
    967718               ENDIF 
    968                frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    969                frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid 
     719               sf(jp_itx1)%fnow(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     720               sf(jp_ity1)%fnow(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid 
    970721            ENDIF 
    971722            !                                                   ! ======================= ! 
    972723         ELSE                                                   !     use ocean stress    ! 
    973724            !                                                   ! ======================= ! 
    974             frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1) 
    975             frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1) 
     725            sf(jp_itx1)%fnow(:,:,1) = sf(jp_otx1)%fnow(:,:,1) 
     726            sf(jp_ity1)%fnow(:,:,1) = sf(jp_oty1)%fnow(:,:,1) 
    976727            ! 
    977728         ENDIF 
     
    992743            ! 
    993744         CASE( 'I' )                                         ! B-grid ==> I 
    994             SELECT CASE ( srcv(jpr_itx1)%clgrid ) 
     745            SELECT CASE ( sf(jp_itx1)%clvgrd ) 
    995746            CASE( 'U' ) 
    996747               DO jj = 2, jpjm1                                   ! (U,V) ==> I 
    997748                  DO ji = 2, jpim1   ! NO vector opt. 
    998                      p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 
    999                      p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 
     749                     p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji-1,jj  ,1) + sf(jp_itx1)%fnow(ji-1,jj-1,1) ) 
     750                     p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji  ,jj-1,1) + sf(jp_ity1)%fnow(ji-1,jj-1,1) ) 
    1000751                  END DO 
    1001752               END DO 
     
    1003754               DO jj = 2, jpjm1                                   ! F ==> I 
    1004755                  DO ji = 2, jpim1   ! NO vector opt. 
    1005                      p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1) 
    1006                      p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1) 
     756                     p_taui(ji,jj) = sf(jp_itx1)%fnow(ji-1,jj-1,1) 
     757                     p_tauj(ji,jj) = sf(jp_ity1)%fnow(ji-1,jj-1,1) 
    1007758                  END DO 
    1008759               END DO 
     
    1010761               DO jj = 2, jpjm1                                   ! T ==> I 
    1011762                  DO ji = 2, jpim1   ! NO vector opt. 
    1012                      p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj  ,1)   & 
    1013                         &                   + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )  
    1014                      p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1)   & 
    1015                         &                   + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 
     763                     p_taui(ji,jj) = 0.25 * ( sf(jp_itx1)%fnow(ji,jj  ,1) + sf(jp_itx1)%fnow(ji-1,jj  ,1)   & 
     764                        &                   + sf(jp_itx1)%fnow(ji,jj-1,1) + sf(jp_itx1)%fnow(ji-1,jj-1,1) )  
     765                     p_tauj(ji,jj) = 0.25 * ( sf(jp_ity1)%fnow(ji,jj  ,1) + sf(jp_ity1)%fnow(ji-1,jj  ,1)   & 
     766                        &                   + sf(jp_oty1)%fnow(ji,jj-1,1) + sf(jp_ity1)%fnow(ji-1,jj-1,1) ) 
    1016767                  END DO 
    1017768               END DO 
    1018769            CASE( 'I' ) 
    1019                p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! I ==> I 
    1020                p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
     770               p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1)                   ! I ==> I 
     771               p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 
    1021772            END SELECT 
    1022             IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN  
     773            IF( sf(jp_itx1)%clvgrd /= 'I' ) THEN  
    1023774               CALL lbc_lnk( p_taui, 'I',  -1. )   ;   CALL lbc_lnk( p_tauj, 'I',  -1. ) 
    1024775            ENDIF 
    1025776            ! 
    1026777         CASE( 'F' )                                         ! B-grid ==> F 
    1027             SELECT CASE ( srcv(jpr_itx1)%clgrid ) 
     778            SELECT CASE ( sf(jp_itx1)%clvgrd ) 
    1028779            CASE( 'U' ) 
    1029780               DO jj = 2, jpjm1                                   ! (U,V) ==> F 
    1030781                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1031                      p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj+1,1) ) 
    1032                      p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1) ) 
     782                     p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji,jj,1) + sf(jp_itx1)%fnow(ji  ,jj+1,1) ) 
     783                     p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji,jj,1) + sf(jp_ity1)%fnow(ji+1,jj  ,1) ) 
    1033784                  END DO 
    1034785               END DO 
     
    1036787               DO jj = 2, jpjm1                                   ! I ==> F 
    1037788                  DO ji = 2, jpim1   ! NO vector opt. 
    1038                      p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1) 
    1039                      p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1) 
     789                     p_taui(ji,jj) = sf(jp_itx1)%fnow(ji+1,jj+1,1) 
     790                     p_tauj(ji,jj) = sf(jp_ity1)%fnow(ji+1,jj+1,1) 
    1040791                  END DO 
    1041792               END DO 
     
    1043794               DO jj = 2, jpjm1                                   ! T ==> F 
    1044795                  DO ji = 2, jpim1   ! NO vector opt. 
    1045                      p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1)   & 
    1046                         &                   + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )  
    1047                      p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1)   & 
    1048                         &                   + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) ) 
     796                     p_taui(ji,jj) = 0.25 * ( sf(jp_itx1)%fnow(ji,jj  ,1) + sf(jp_itx1)%fnow(ji+1,jj  ,1)   & 
     797                        &                   + sf(jp_itx1)%fnow(ji,jj+1,1) + sf(jp_itx1)%fnow(ji+1,jj+1,1) )  
     798                     p_tauj(ji,jj) = 0.25 * ( sf(jp_ity1)%fnow(ji,jj  ,1) + sf(jp_ity1)%fnow(ji+1,jj  ,1)   & 
     799                        &                   + sf(jp_ity1)%fnow(ji,jj+1,1) + sf(jp_ity1)%fnow(ji+1,jj+1,1) ) 
    1049800                  END DO 
    1050801               END DO 
    1051802            CASE( 'F' ) 
    1052                p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! F ==> F 
    1053                p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
     803               p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1)                   ! F ==> F 
     804               p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 
    1054805            END SELECT 
    1055             IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN  
     806            IF( sf(jp_itx1)%clvgrd /= 'F' ) THEN  
    1056807               CALL lbc_lnk( p_taui, 'F',  -1. )   ;   CALL lbc_lnk( p_tauj, 'F',  -1. ) 
    1057808            ENDIF 
    1058809            ! 
    1059810         CASE( 'C' )                                         ! C-grid ==> U,V 
    1060             SELECT CASE ( srcv(jpr_itx1)%clgrid ) 
     811            SELECT CASE ( sf(jp_itx1)%clvgrd ) 
    1061812            CASE( 'U' ) 
    1062                p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V) 
    1063                p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
     813               p_taui(:,:) = sf(jp_itx1)%fnow(:,:,1)                   ! (U,V) ==> (U,V) 
     814               p_tauj(:,:) = sf(jp_ity1)%fnow(:,:,1) 
    1064815            CASE( 'F' ) 
    1065816               DO jj = 2, jpjm1                                   ! F ==> (U,V) 
    1066817                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1067                      p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) ) 
    1068                      p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) ) 
     818                     p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji,jj,1) + sf(jp_itx1)%fnow(ji  ,jj-1,1) ) 
     819                     p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(jj,jj,1) + sf(jp_ity1)%fnow(ji-1,jj  ,1) ) 
    1069820                  END DO 
    1070821               END DO 
     
    1072823               DO jj = 2, jpjm1                                   ! T ==> (U,V) 
    1073824                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1074                      p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
    1075                      p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
     825                     p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji+1,jj  ,1) + sf(jp_itx1)%fnow(ji,jj,1) ) 
     826                     p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji  ,jj+1,1) + sf(jp_ity1)%fnow(ji,jj,1) ) 
    1076827                  END DO 
    1077828               END DO 
     
    1079830               DO jj = 2, jpjm1                                   ! I ==> (U,V) 
    1080831                  DO ji = 2, jpim1   ! NO vector opt. 
    1081                      p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) ) 
    1082                      p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) ) 
     832                     p_taui(ji,jj) = 0.5 * ( sf(jp_itx1)%fnow(ji+1,jj+1,1) + sf(jp_itx1)%fnow(ji+1,jj  ,1) ) 
     833                     p_tauj(ji,jj) = 0.5 * ( sf(jp_ity1)%fnow(ji+1,jj+1,1) + sf(jp_ity1)%fnow(ji  ,jj+1,1) ) 
    1083834                  END DO 
    1084835               END DO 
    1085836            END SELECT 
    1086             IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN  
     837            IF( sf(jp_itx1)%clvgrd /= 'U' ) THEN  
    1087838               CALL lbc_lnk( p_taui, 'U',  -1. )   ;   CALL lbc_lnk( p_tauj, 'V',  -1. ) 
    1088839            ENDIF 
     
    1163914      !                                                           ! solid Precipitation                      (sprecip) 
    1164915      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    1165       CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1166          sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
    1167          tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
    1168          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
    1169          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    1170                            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    1171          IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
    1172          ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
     916      CASE( 'conservative'  )   ! received fields: jp_rain, jp_snow, jp_ievp, jp_tevp 
     917         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1)                 ! May need to ensure positive here 
     918         tprecip(:,:) = sf(jp_rain)%fnow(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
     919         emp_tot(:,:) = sf(jp_tevp)%fnow(:,:,1) - tprecip(:,:) 
     920         emp_ice(:,:) = sf(jp_ievp)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) 
     921                           CALL iom_put( 'rain'         , sf(jp_rain)%fnow(:,:,1)              )   ! liquid precipitation  
     922         IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', sf(jp_rain)%fnow(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
     923         ztmp(:,:) = sf(jp_tevp)%fnow(:,:,1) - sf(jp_ievp)%fnow(:,:,1) * zicefr(:,:) 
    1173924                           CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average) 
    1174925         IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave) 
    1175       CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    1176          emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    1177          emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
    1178          sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
     926      CASE( 'oce and ice'   )   ! received fields: jp_sbpr, jp_semp, jp_oemp, jp_ievp 
     927         emp_tot(:,:) = p_frld(:,:) * sf(jp_oemp)%fnow(:,:,1) + zicefr(:,:) * sf(jp_sbpr)%fnow(:,:,1) 
     928         emp_ice(:,:) = sf(jp_semp)%fnow(:,:,1) 
     929         sprecip(:,:) = - sf(jp_semp)%fnow(:,:,1) + sf(jp_ievp)%fnow(:,:,1) 
    1179930      END SELECT 
    1180931 
     
    1182933      CALL iom_put( 'snow_ao_cea', sprecip(:,:         ) * p_frld(:,:)    )   ! Snow        over ice-free ocean  (cell average) 
    1183934      CALL iom_put( 'snow_ai_cea', sprecip(:,:         ) * zicefr(:,:)    )   ! Snow        over sea-ice         (cell average) 
    1184       CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
     935      CALL iom_put( 'subl_ai_cea', sf(jp_ievp)%fnow(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    1185936      !    
    1186937      !                                                           ! runoffs and calving (put in emp_tot) 
    1187       IF( srcv(jpr_rnf)%laction ) THEN  
    1188          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    1189                            CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
    1190          IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    1191       ENDIF 
    1192       IF( srcv(jpr_cal)%laction ) THEN  
    1193          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1194          CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
     938      IF( sf(jp_rnf)%loasis ) THEN  
     939         emp_tot(:,:) = emp_tot(:,:) - sf(jp_rnf)%fnow(:,:,1) 
     940                           CALL iom_put( 'runoffs'      , sf(jp_rnf)%fnow(:,:,1)              )   ! rivers 
     941         IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , sf(jp_rnf)%fnow(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
     942      ENDIF 
     943      IF( sf(jp_cal)%loasis ) THEN  
     944         emp_tot(:,:) = emp_tot(:,:) - sf(jp_cal)%fnow(:,:,1) 
     945         CALL iom_put( 'calving', sf(jp_cal)%fnow(:,:,1) ) 
    1195946      ENDIF 
    1196947      ! 
     
    1198949!!gm                                       at least should be optional... 
    1199950!!       ! remove negative runoff                            ! sum over the global domain 
    1200 !!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1201 !!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
     951!!       zcumulpos = SUM( MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
     952!!       zcumulneg = SUM( MIN( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    1202953!!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    1203954!!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    1204955!!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points 
    1205956!!          zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    1206 !!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
     957!!          sf(jp_rnf)%fnow(:,:,1) = MAX( sf(jp_rnf)%fnow(:,:,1), 0.e0 ) * zcumulneg 
    1207958!!       ENDIF      
    1208 !!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
     959!!       emp_tot(:,:) = emp_tot(:,:) - sf(jp_rnf)%fnow(:,:,1)   ! add runoff to e-p  
    1209960!! 
    1210961!!gm  end of internal cooking 
     
    1214965      !                                                      ! ========================= ! 
    1215966      CASE( 'oce only' )                                     ! the required field is directly provided 
    1216          qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
     967         qns_tot(:,:  ) = sf(jp_qnsoce)%fnow(:,:,1) 
    1217968      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1218          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     969         qns_tot(:,:  ) = sf(jp_qnsmix)%fnow(:,:,1) 
    1219970         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    1220             qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     971            qns_ice(:,:,1:jpl) = sf(jp_qnsice)%fnow(:,:,1:jpl) 
    1221972         ELSE 
    1222973            ! Set all category values equal for the moment 
    1223974            DO jl=1,jpl 
    1224                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     975               qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,1) 
    1225976            ENDDO 
    1226977         ENDIF 
    1227978      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1228          qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     979         qns_tot(:,:  ) =  p_frld(:,:) * sf(jp_qnsoce)%fnow(:,:,1) 
    1229980         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    1230981            DO jl=1,jpl 
    1231                qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
    1232                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     982               qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * sf(jp_qnsice)%fnow(:,:,jl)    
     983               qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,jl) 
    1233984            ENDDO 
    1234985         ELSE 
    1235986            DO jl=1,jpl 
    1236                qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    1237                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     987               qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * sf(jp_qnsice)%fnow(:,:,1) 
     988               qns_ice(:,:,jl) = sf(jp_qnsice)%fnow(:,:,1) 
    1238989            ENDDO 
    1239990         ENDIF 
    1240991      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    1241992! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    1242          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1243          qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    1244             &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
     993         qns_tot(:,:  ) = sf(jp_qnsmix)%fnow(:,:,1) 
     994         qns_ice(:,:,1) = sf(jp_qnsmix)%fnow(:,:,1)    & 
     995            &            + sf(jp_dqnsdt)%fnow(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
    1245996            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    1246997      END SELECT 
     
    12591010!! similar job should be done for snow and precipitation temperature 
    12601011      !                                      
    1261       IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    1262          ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
     1012      IF( sf(jp_cal)%loasis ) THEN                            ! Iceberg melting  
     1013         ztmp(:,:) = sf(jp_cal)%fnow(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    12631014         qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
    1264          IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
     1015         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + sf(jp_cal)%fnow(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12651016      ENDIF 
    12661017 
     
    12691020      !                                                      ! ========================= ! 
    12701021      CASE( 'oce only' ) 
    1271          qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1022         qsr_tot(:,:  ) = MAX( 0._wp , sf(jp_qsroce)%fnow(:,:,1) ) 
    12721023      CASE( 'conservative' ) 
    1273          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1024         qsr_tot(:,:  ) = sf(jp_qsrmix)%fnow(:,:,1) 
    12741025         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    1275             qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1026            qsr_ice(:,:,1:jpl) = sf(jp_qsrice)%fnow(:,:,1:jpl) 
    12761027         ELSE 
    12771028            ! Set all category values equal for the moment 
    12781029            DO jl=1,jpl 
    1279                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1030               qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,1) 
    12801031            ENDDO 
    12811032         ENDIF 
    1282          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1283          qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
     1033         qsr_tot(:,:  ) = sf(jp_qsrmix)%fnow(:,:,1) 
     1034         qsr_ice(:,:,1) = sf(jp_qsrice)%fnow(:,:,1) 
    12841035      CASE( 'oce and ice' ) 
    1285          qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1036         qsr_tot(:,:  ) =  p_frld(:,:) * sf(jp_qsroce)%fnow(:,:,1) 
    12861037         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    12871038            DO jl=1,jpl 
    1288                qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
    1289                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1039               qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * sf(jp_qsrice)%fnow(:,:,jl)    
     1040               qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,jl) 
    12901041            ENDDO 
    12911042         ELSE 
    12921043            DO jl=1,jpl 
    1293                qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    1294                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1044               qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * sf(jp_qsrice)%fnow(:,:,1) 
     1045               qsr_ice(:,:,jl) = sf(jp_qsrice)%fnow(:,:,1) 
    12951046            ENDDO 
    12961047         ENDIF 
    12971048      CASE( 'mixed oce-ice' ) 
    1298          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1049         qsr_tot(:,:  ) = sf(jp_qsrmix)%fnow(:,:,1) 
    12991050! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    13001051!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    13011052!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1302          qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1053         qsr_ice(:,:,1) = sf(jp_qsrmix)%fnow(:,:,1) * ( 1.- palbi(:,:,1) )   & 
    13031054            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
    13041055            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
     
    13141065      CASE ('coupled') 
    13151066         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    1316             dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1067            dqns_ice(:,:,1:jpl) = sf(jp_dqnsdt)%fnow(:,:,1:jpl) 
    13171068         ELSE 
    13181069            ! Set all category values equal for the moment 
    13191070            DO jl=1,jpl 
    1320                dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1071               dqns_ice(:,:,jl) = sf(jp_dqnsdt)%fnow(:,:,1) 
    13211072            ENDDO 
    13221073         ENDIF 
     
    13251076      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
    13261077      CASE ('coupled') 
    1327          topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
    1328          botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 
     1078         topmelt(:,:,:)=sf(jp_topm)%fnow(:,:,:) 
     1079         botmelt(:,:,:)=sf(jp_botm)%fnow(:,:,:) 
    13291080      END SELECT 
    13301081 
  • branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r3625 r4827  
    1717   USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr 
    1818   USE phycst          ! physical constants 
    19    USE fldread         ! read input fields 
     19   USE fldread2        ! read input fields 
     20   USE fld_def 
     21   USE sbcget 
    2022   USE iom             ! IOM library 
    2123   USE in_out_manager  ! I/O manager 
     
    2729 
    2830   PUBLIC sbc_flx       ! routine called by step.F90 
    29  
    30    INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read  
    31    INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file 
    32    INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file 
    33    INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file 
    34    INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file 
    35    INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
    36    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    3731 
    3832   !! * Substitutions 
     
    7670      !! 
    7771      INTEGER  ::   ji, jj, jf            ! dummy indices 
    78       INTEGER  ::   ierror                ! return error code 
    7972      REAL(wp) ::   zfact                 ! temporary scalar 
    8073      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3 
     
    8275      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
    8376      !! 
    84       CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
    85       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures 
    86       TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read 
    87       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 
     77!      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
     78!      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 
    8879      !!--------------------------------------------------------------------- 
    8980      ! 
    9081      IF( kt == nit000 ) THEN                ! First call kt=nit000   
    91          ! set file information 
    92          cn_dir = './'        ! directory in which the model is executed 
    93          ! ... default values (NB: frequency positive => hours, negative => months) 
    94          !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
    95          !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     ! 
    96          sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    97          sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    98          sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    99          sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    100          sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
    101          ! 
    102          REWIND ( numnam )                         ! read in namlist namflx 
    103          READ   ( numnam, namsbc_flx )  
    10482         ! 
    10583         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    106          IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
     84         IF( ln_dm2dc .AND. sf(jp_qsroce)%nfreqh /= 24 )   & 
    10785            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )  
    108          ! 
    109          !                                         ! store namelist information in an array 
    110          slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau 
    111          slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr  
    112          slf_i(jp_emp ) = sn_emp 
    113          ! 
    114          ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
    115          IF( ierror > 0 ) THEN    
    116             CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
    117          ENDIF 
    118          DO ji= 1, jpfld 
    119             ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 
    120             IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 
    121          END DO 
    122          !                                         ! fill sf with slf_i and control print 
    123          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 
    12486         ! 
    12587         sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90) 
     
    12789      ENDIF 
    12890 
    129       CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step 
    130       
    13191      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    13292 
    133          IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle 
    134          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1) 
     93         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsroce)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle 
     94         ELSE                  ;   qsr(:,:) =          sf(jp_qsroce)%fnow(:,:,1) 
    13595         ENDIF 
    13696!CDIR COLLAPSE 
    13797         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    13898            DO ji = 1, jpi 
    139                utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
    140                vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    141                qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    142                emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     99               utau(ji,jj) = sf(jp_otx1)%fnow(ji,jj,1) 
     100               vtau(ji,jj) = sf(jp_oty1)%fnow(ji,jj,1) 
     101               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsroce)%fnow(ji,jj,1) 
     102               emp (ji,jj) = sf(jp_oemp )%fnow(ji,jj,1) 
    143103            END DO 
    144104         END DO 
     
    165125            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
    166126            DO jf = 1, jpfld 
    167                IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1. 
    168                IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1 
    169                IF( jf == jp_emp                     )   zfact = 86400. 
     127               IF( jf == jp_otx1 .OR. jf == jp_oty1  )   zfact =     1. 
     128               IF( jf == jp_qtot .OR. jf == jp_qsroce )   zfact =     0.1 
     129               IF( jf == jp_oemp                       )   zfact = 86400. 
    170130               WRITE(numout,*)  
    171131               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 
  • branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r3625 r4827  
    2222   USE timing          ! Timing 
    2323   USE daymod          ! calendar 
    24    USE fldread         ! read input fields 
     24   USE fld_def 
    2525 
    2626   USE sbc_oce         ! Surface boundary condition: ocean fields 
     
    2828   USE sbcblk_core     ! Surface boundary condition: CORE bulk 
    2929   USE sbccpl 
     30   USE sbcget 
    3031 
    3132   USE ice_kinds_mod 
     
    6263   INTEGER , PARAMETER ::   ji_off = INT ( (jpiglo - nx_global) / 2 ) 
    6364   INTEGER , PARAMETER ::   jj_off = INT ( (jpjglo - ny_global) / 2 ) 
    64  
    65    INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read  
    66    INTEGER , PARAMETER ::   jp_snow = 1    ! index of snow file 
    67    INTEGER , PARAMETER ::   jp_rain = 2    ! index of rain file 
    68    INTEGER , PARAMETER ::   jp_sblm = 3    ! index of sublimation file 
    69    INTEGER , PARAMETER ::   jp_top1 = 4    ! index of category 1 topmelt file 
    70    INTEGER , PARAMETER ::   jp_top2 = 5    ! index of category 2 topmelt file 
    71    INTEGER , PARAMETER ::   jp_top3 = 6    ! index of category 3 topmelt file 
    72    INTEGER , PARAMETER ::   jp_top4 = 7    ! index of category 4 topmelt file 
    73    INTEGER , PARAMETER ::   jp_top5 = 8    ! index of category 5 topmelt file 
    74    INTEGER , PARAMETER ::   jp_bot1 = 9    ! index of category 1 botmelt file 
    75    INTEGER , PARAMETER ::   jp_bot2 = 10   ! index of category 2 botmelt file 
    76    INTEGER , PARAMETER ::   jp_bot3 = 11   ! index of category 3 botmelt file 
    77    INTEGER , PARAMETER ::   jp_bot4 = 12   ! index of category 4 botmelt file 
    78    INTEGER , PARAMETER ::   jp_bot5 = 13   ! index of category 5 botmelt file 
    79    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    8065 
    8166   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE ::   png     ! local array used in sbc_cice_ice 
     
    655640      IF( kt == nit000 )  THEN 
    656641         IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 
    657          IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
     642!         IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    658643      ENDIF 
    659644 
     
    705690      !! 
    706691      !!--------------------------------------------------------------------- 
    707       !! ** Method  :   READ monthly flux file in NetCDF files 
     692      !! ** Method  :   Set forcing fields 
    708693      !!       
    709694      !!  snowfall     
     
    716701      !!---------------------------------------------------------------------- 
    717702      !! * Modules used 
    718       USE iom 
    719  
    720       !! * arguments 
     703 
    721704      INTEGER, INTENT( in  ) ::   kt ! ocean time step 
    722705 
    723       INTEGER  ::   ierror             ! return error code 
    724       INTEGER  ::   ifpr               ! dummy loop index 
    725       !! 
    726       CHARACTER(len=100) ::  cn_dir                            !   Root directory for location of CICE forcing files 
    727       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read 
    728       TYPE(FLD_N) ::   sn_snow, sn_rain, sn_sblm               ! informations about the fields to be read 
    729       TYPE(FLD_N) ::   sn_top1, sn_top2, sn_top3, sn_top4, sn_top5 
    730       TYPE(FLD_N) ::   sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5  
    731  
    732       !! 
    733       NAMELIST/namsbc_cice/ cn_dir, sn_snow, sn_rain, sn_sblm,   & 
    734          &                          sn_top1, sn_top2, sn_top3, sn_top4, sn_top5,  & 
    735          &                          sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5 
    736       !!--------------------------------------------------------------------- 
    737  
    738       !                                         ! ====================== ! 
    739       IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    740          !                                      ! ====================== ! 
    741          ! set file information (default values) 
    742          cn_dir = './'       ! directory in which the model is executed 
    743  
    744          ! (NB: frequency positive => hours, negative => months) 
    745          !            !    file          ! frequency !  variable    ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    746          !            !    name          !  (hours)  !   name       !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    747          sn_snow = FLD_N( 'snowfall_1m'  ,    -1.    ,  'snowfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         )  
    748          sn_rain = FLD_N( 'rainfall_1m'  ,    -1.    ,  'rainfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         )  
    749          sn_sblm = FLD_N( 'sublim_1m'    ,    -1.    ,  'sublim'    ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    750          sn_top1 = FLD_N( 'topmeltn1_1m' ,    -1.    ,  'topmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    751          sn_top2 = FLD_N( 'topmeltn2_1m' ,    -1.    ,  'topmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    752          sn_top3 = FLD_N( 'topmeltn3_1m' ,    -1.    ,  'topmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    753          sn_top4 = FLD_N( 'topmeltn4_1m' ,    -1.    ,  'topmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    754          sn_top5 = FLD_N( 'topmeltn5_1m' ,    -1.    ,  'topmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    755          sn_bot1 = FLD_N( 'botmeltn1_1m' ,    -1.    ,  'botmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    756          sn_bot2 = FLD_N( 'botmeltn2_1m' ,    -1.    ,  'botmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    757          sn_bot3 = FLD_N( 'botmeltn3_1m' ,    -1.    ,  'botmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    758          sn_bot4 = FLD_N( 'botmeltn4_1m' ,    -1.    ,  'botmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    759          sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    760  
    761 !         REWIND ( numnam )               ! ... at some point might read in from NEMO namelist? 
    762 !         READ   ( numnam, namsbc_cice )  
    763  
    764          ! store namelist information in an array 
    765          slf_i(jp_snow) = sn_snow   ;   slf_i(jp_rain) = sn_rain   ;   slf_i(jp_sblm) = sn_sblm 
    766          slf_i(jp_top1) = sn_top1   ;   slf_i(jp_top2) = sn_top2   ;   slf_i(jp_top3) = sn_top3 
    767          slf_i(jp_top4) = sn_top4   ;   slf_i(jp_top5) = sn_top5   ;   slf_i(jp_bot1) = sn_bot1 
    768          slf_i(jp_bot2) = sn_bot2   ;   slf_i(jp_bot3) = sn_bot3   ;   slf_i(jp_bot4) = sn_bot4 
    769          slf_i(jp_bot5) = sn_bot5 
    770           
    771          ! set sf structure 
    772          ALLOCATE( sf(jpfld), STAT=ierror ) 
    773          IF( ierror > 0 ) THEN 
    774             CALL ctl_stop( 'cice_sbc_force: unable to allocate sf structure' )   ;   RETURN 
    775          ENDIF 
    776  
    777          DO ifpr= 1, jpfld 
    778             ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    779             ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    780          END DO 
    781  
    782          ! fill sf with slf_i and control print 
    783          CALL fld_fill( sf, slf_i, cn_dir, 'cice_sbc_force', 'flux formulation for CICE', 'namsbc_cice' ) 
    784          ! 
    785       ENDIF 
    786  
    787       CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the 
    788       !                                          ! input fields at the current time-step 
     706      ! Assume the fluxes have already been obtained somewhere.... 
    789707 
    790708      ! set the fluxes from read fields 
     
    792710      tprecip(:,:) = sf(jp_snow)%fnow(:,:,1)+sf(jp_rain)%fnow(:,:,1) 
    793711! May be better to do this conversion somewhere else 
    794       qla_ice(:,:,1) = -Lsub*sf(jp_sblm)%fnow(:,:,1) 
    795       topmelt(:,:,1) = sf(jp_top1)%fnow(:,:,1) 
    796       topmelt(:,:,2) = sf(jp_top2)%fnow(:,:,1) 
    797       topmelt(:,:,3) = sf(jp_top3)%fnow(:,:,1) 
    798       topmelt(:,:,4) = sf(jp_top4)%fnow(:,:,1) 
    799       topmelt(:,:,5) = sf(jp_top5)%fnow(:,:,1) 
    800       botmelt(:,:,1) = sf(jp_bot1)%fnow(:,:,1) 
    801       botmelt(:,:,2) = sf(jp_bot2)%fnow(:,:,1) 
    802       botmelt(:,:,3) = sf(jp_bot3)%fnow(:,:,1) 
    803       botmelt(:,:,4) = sf(jp_bot4)%fnow(:,:,1) 
    804       botmelt(:,:,5) = sf(jp_bot5)%fnow(:,:,1) 
    805  
    806       ! control print (if less than 100 time-step asked) 
    807       IF( nitend-nit000 <= 100 .AND. lwp ) THEN 
    808          WRITE(numout,*)  
    809          WRITE(numout,*) '        read forcing fluxes for CICE OK' 
    810          CALL FLUSH(numout) 
    811       ENDIF 
     712      qla_ice(:,:,1) = -Lsub*sf(jp_ievp)%fnow(:,:,1) 
     713      topmelt(:,:,:) = sf(jp_topm)%fnow(:,:,:) 
     714      botmelt(:,:,:) = sf(jp_botm)%fnow(:,:,:) 
    812715 
    813716   END SUBROUTINE cice_sbc_force 
  • branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3764 r4827  
    3737   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3838   USE sbccpl           ! surface boundary condition: coupled florulation 
     39   USE sbcget 
    3940   USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    4041   USE sbcssr           ! surface boundary condition: sea surface restoring 
     
    221222      IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    222223      ! 
     224      CALL sbc_get_init 
     225      ! 
    223226      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    224227      ! 
     
    258261         sfx_b(:,:) = sfx(:,:) 
    259262      ENDIF 
     263      ! 
     264      CALL sbc_get( kt ) 
     265      ! 
    260266      !                                            ! ---------------------------------------- ! 
    261267      !                                            !        forcing field computation         ! 
Note: See TracChangeset for help on using the changeset viewer.