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

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

Ignore:
Timestamp:
2015-07-21T10:55:28+02:00 (9 years ago)
Author:
jamesharle
Message:

Merge with r5619 of trunk, update to unstructured BDY interpolation in
fldread.F90. Structured BDY interpolation incomplete.

Location:
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
24 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r5038 r5620  
    1515   !!---------------------------------------------------------------------- 
    1616   !!---------------------------------------------------------------------- 
    17    !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
     17   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT 
     18   !!   'key_oa3mct_v3'                 to be added for OASIS3-MCT version 3 
    1819   !!---------------------------------------------------------------------- 
    1920   !!   cpl_init     : initialization of coupled mode communication 
     
    6162#endif 
    6263 
    63    INTEGER, PUBLIC, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields 
     64   INTEGER                    ::   nrcv         ! total number of fields received  
     65   INTEGER                    ::   nsnd         ! total number of fields sent  
     66   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     67   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=50   ! Maximum number of coupling fields 
    6468   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    6569   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
     
    8690CONTAINS 
    8791 
    88    SUBROUTINE cpl_init( kl_comm ) 
     92   SUBROUTINE cpl_init( cd_modname, kl_comm ) 
    8993      !!------------------------------------------------------------------- 
    9094      !!             ***  ROUTINE cpl_init  *** 
     
    9599      !! ** Method  :   OASIS3 MPI communication  
    96100      !!-------------------------------------------------------------------- 
    97       INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model 
     101      CHARACTER(len = *), INTENT(in) ::   cd_modname   ! model name as set in namcouple file 
     102      INTEGER          , INTENT(out) ::   kl_comm      ! local communicator of the model 
    98103      !!-------------------------------------------------------------------- 
    99104 
     
    104109      ! 1st Initialize the OASIS system for the application 
    105110      !------------------------------------------------------------------ 
    106       CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 
     111      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 
    107112      IF ( nerror /= OASIS_Ok ) & 
    108113         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
     
    144149      IF(lwp) WRITE(numout,*) 
    145150 
     151      ncplmodel = kcplmodel 
    146152      IF( kcplmodel > nmaxcpl ) THEN 
    147          CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
     153         CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
    148154      ENDIF 
     155 
     156      nrcv = krcv 
     157      IF( nrcv > nmaxfld ) THEN 
     158         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld')   ;   RETURN 
     159      ENDIF 
     160 
     161      nsnd = ksnd 
     162      IF( nsnd > nmaxfld ) THEN 
     163         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN 
     164      ENDIF 
     165 
    149166      ! 
    150167      ! ... Define the shape for the area that excludes the halo 
     
    400417 
    401418 
    402    INTEGER FUNCTION cpl_freq( kid 
     419   INTEGER FUNCTION cpl_freq( cdfieldname 
    403420      !!--------------------------------------------------------------------- 
    404421      !!              ***  ROUTINE cpl_freq  *** 
     
    406423      !! ** Purpose : - send back the coupling frequency for a particular field 
    407424      !!---------------------------------------------------------------------- 
    408       INTEGER,INTENT(in) ::   kid   ! variable index 
    409       !! 
     425      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file 
     426      !! 
     427      INTEGER               :: id 
    410428      INTEGER               :: info 
    411429      INTEGER, DIMENSION(1) :: itmp 
     430      INTEGER               :: ji,jm     ! local loop index 
     431      INTEGER               :: mop 
    412432      !!---------------------------------------------------------------------- 
    413       CALL oasis_get_freqs(kid, 1, itmp, info) 
    414       cpl_freq = itmp(1) 
     433      cpl_freq = 0   ! defaut definition 
     434      id = -1        ! defaut definition 
     435      ! 
     436      DO ji = 1, nsnd 
     437         IF (ssnd(ji)%laction ) THEN 
     438            DO jm = 1, ncplmodel 
     439               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 
     440                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN 
     441                     id = ssnd(ji)%nid(1,jm) 
     442                     mop = OASIS_Out 
     443                  ENDIF 
     444               ENDIF 
     445            ENDDO 
     446         ENDIF 
     447      ENDDO 
     448      DO ji = 1, nrcv 
     449         IF (srcv(ji)%laction ) THEN 
     450            DO jm = 1, ncplmodel 
     451               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 
     452                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN 
     453                     id = srcv(ji)%nid(1,jm) 
     454                     mop = OASIS_In 
     455                  ENDIF 
     456               ENDIF 
     457            ENDDO 
     458         ENDIF 
     459      ENDDO 
     460      ! 
     461      IF( id /= -1 ) THEN 
     462#if defined key_oa3mct_v3 
     463         CALL oasis_get_freqs(id, mop, 1, itmp, info) 
     464#else 
     465         CALL oasis_get_freqs(id,      1, itmp, info) 
     466#endif 
     467         cpl_freq = itmp(1) 
     468      ENDIF 
    415469      ! 
    416470   END FUNCTION cpl_freq 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90

    • Property svn:keywords set to Id
    r4230 r5620  
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    43    !! $Id: module_example 1146 2008-06-25 11:42:56Z rblod $  
     43   !! $Id$  
    4444   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r5035 r5620  
    7171   END TYPE FLD 
    7272 
    73    TYPE, PUBLIC ::   MAP_POINTER      !: Array of integer pointers to 1D arrays 
    74       INTEGER, POINTER   ::  ptr(:) 
     73   TYPE, PUBLIC ::   MAP_POINTER      !: Map from input data file to local domain 
     74      INTEGER, POINTER, DIMENSION(:)  ::  ptr           ! Array of integer pointers to 1D arrays 
     75      LOGICAL                         ::  ll_unstruc    ! Unstructured (T) or structured (F) boundary data file 
    7576   END TYPE MAP_POINTER 
    7677 
     
    115116CONTAINS 
    116117 
    117    SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset, jpk_bdy ) 
     118   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset, jpk_bdy, fvl ) 
    118119      !!--------------------------------------------------------------------- 
    119120      !!                    ***  ROUTINE fld_read  *** 
     
    138139      !! 
    139140      INTEGER  , INTENT(in   ), OPTIONAL     ::   jpk_bdy   ! number of vertical levels in the BDY data 
     141      LOGICAL  , INTENT(in   ), OPTIONAL     ::   fvl   ! number of vertical levels in the BDY data 
    140142      !! 
    141143      INTEGER  ::   itmp       ! temporary variable 
     
    157159      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1 
    158160 
    159       it_offset = 0 
     161      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     162      ELSE                                      ;   it_offset = 0 
     163      ENDIF 
    160164      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    161165 
     
    174178            IF( PRESENT(map) ) imap = map(jf) 
    175179               IF( PRESENT(jpk_bdy) ) THEN 
    176                   CALL fld_init( kn_fsbc, sd(jf), imap, jpk_bdy )  ! read each before field (put them in after as they will be swapped) 
     180                  CALL fld_init( kn_fsbc, sd(jf), imap, jpk_bdy, fvl )  ! read each before field (put them in after as they will be swapped) 
    177181               ELSE 
    178182                  CALL fld_init( kn_fsbc, sd(jf), imap )  ! read each before field (put them in after as they will be swapped) 
     
    270274               ! read after data 
    271275               IF( PRESENT(jpk_bdy) ) THEN 
    272                   CALL fld_get( sd(jf), imap, jpk_bdy) 
     276                  CALL fld_get( sd(jf), imap, jpk_bdy, fvl) 
    273277               ELSE 
    274278                  CALL fld_get( sd(jf), imap ) 
     
    314318 
    315319 
    316    SUBROUTINE fld_init( kn_fsbc, sdjf, map , jpk_bdy) 
     320   SUBROUTINE fld_init( kn_fsbc, sdjf, map , jpk_bdy, fvl) 
    317321      !!--------------------------------------------------------------------- 
    318322      !!                    ***  ROUTINE fld_init  *** 
     
    325329      TYPE(MAP_POINTER),INTENT(in)     :: map       ! global-to-local mapping indices 
    326330      INTEGER  , INTENT(in), OPTIONAL  :: jpk_bdy   ! number of vertical levels in the BDY data 
     331      LOGICAL  , INTENT(in), OPTIONAL  :: fvl   ! number of vertical levels in the BDY data 
    327332      !! 
    328333      LOGICAL :: llprevyr              ! are we reading previous year  file? 
     
    420425         ! read before data in after arrays(as we will swap it later) 
    421426         IF( PRESENT(jpk_bdy) ) THEN 
    422             CALL fld_get( sdjf, map, jpk_bdy ) 
     427            CALL fld_get( sdjf, map, jpk_bdy, fvl ) 
    423428         ELSE 
    424429            CALL fld_get( sdjf, map ) 
     
    467472      ENDIF 
    468473      ! 
    469       it_offset = 0 
     474      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     475      ELSE                                      ;   it_offset = 0 
     476      ENDIF 
    470477      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    471478      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 
     
    597604 
    598605 
    599    SUBROUTINE fld_get( sdjf, map, jpk_bdy ) 
     606   SUBROUTINE fld_get( sdjf, map, jpk_bdy, fvl ) 
    600607      !!--------------------------------------------------------------------- 
    601608      !!                    ***  ROUTINE fld_get  *** 
     
    606613      TYPE(MAP_POINTER),INTENT(in)    ::   map     ! global-to-local mapping indices 
    607614      INTEGER  , INTENT(in), OPTIONAL ::   jpk_bdy ! number of vertical levels in the bdy data 
     615      LOGICAL  , INTENT(in), OPTIONAL ::   fvl ! number of vertical levels in the bdy data 
    608616      !! 
    609617      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     
    620628         IF( PRESENT(jpk_bdy) ) THEN 
    621629            IF( sdjf%ln_tint ) THEN   ;    
    622                CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map%ptr, sdjf%igrd, sdjf%ibdy, jpk_bdy ) 
     630               CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl ) 
    623631            ELSE                      ;    
    624                CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map%ptr, sdjf%igrd, sdjf%ibdy, jpk_bdy ) 
     632               CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl ) 
    625633            ENDIF 
    626634         ELSE 
    627635            IF( sdjf%ln_tint ) THEN   ;    
    628                CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map%ptr ) 
     636               CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 
    629637            ELSE                      ;    
    630                CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map%ptr ) 
     638               CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map ) 
    631639            ENDIF 
    632640         ENDIF 
     
    685693   END SUBROUTINE fld_get 
    686694 
    687    SUBROUTINE fld_map( num, clvar, dta, nrec, map, igrd, ibdy, jpk_bdy ) 
     695   SUBROUTINE fld_map( num, clvar, dta, nrec, map, igrd, ibdy, jpk_bdy, fvl ) 
    688696      !!--------------------------------------------------------------------- 
    689697      !!                    ***  ROUTINE fld_map  *** 
     
    693701      !!---------------------------------------------------------------------- 
    694702#if defined key_bdy 
    695       USE bdy_oce, ONLY:  dta_global, dta_global_z, dta_global2, dta_global2_z         ! workspace to read in global data arrays 
     703      USE bdy_oce, ONLY:  idx_bdy, dta_global, dta_global_z, dta_global_dz, dta_global2, dta_global2_z, dta_global2_dz                 ! workspace to read in global data arrays 
    696704#endif  
    697705      INTEGER                   , INTENT(in ) ::   num     ! stream number 
     
    699707      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta   ! output field on model grid (2 dimensional) 
    700708      INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice) 
    701       INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices 
     709      TYPE(MAP_POINTER)         , INTENT(in ) ::   map     ! global-to-local mapping indices 
    702710      INTEGER  , INTENT(in), OPTIONAL         ::   igrd, ibdy, jpk_bdy  ! grid type, set number and number of vertical levels in the bdy data 
     711      LOGICAL  , INTENT(in), OPTIONAL         ::   fvl  ! grid type, set number and number of vertical levels in the bdy data 
    703712      INTEGER                                 ::   jpkm1_bdy! number of vertical levels in the bdy data minus 1 
    704713      !! 
     
    713722      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read    ! work space for global data 
    714723      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read_z  ! work space for global data 
     724      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read_dz ! work space for global data 
    715725      !!--------------------------------------------------------------------- 
    716726             
     
    724734#if defined key_bdy 
    725735      ipj = iom_file(num)%dimsz(2,idvar) 
    726       IF (ipj == 1) THEN  
     736      IF ( map%ll_unstruc) THEN ! unstructured open boundary data file 
    727737         dta_read => dta_global 
    728738         IF( PRESENT(jpk_bdy) ) THEN 
    729739            IF( jpk_bdy>0 ) THEN 
    730740               dta_read_z => dta_global_z 
     741               dta_read_dz => dta_global_dz 
    731742               jpkm1_bdy = jpk_bdy-1 
    732743            ENDIF 
    733744         ENDIF 
    734       ELSE ! we assume that this is a structured open boundary file 
     745      ELSE ! structured open boundary file 
    735746         dta_read => dta_global2 
    736747         IF( PRESENT(jpk_bdy) ) THEN 
    737748            IF( jpk_bdy>0 ) THEN 
    738749               dta_read_z => dta_global2_z 
     750               dta_read_dz => dta_global2_dz 
    739751               jpkm1_bdy = jpk_bdy-1 
    740752            ENDIF 
     
    750762      CASE DEFAULT   ;    
    751763   
     764      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     765      ! Do we include something here to adjust barotropic velocities ! 
     766      ! in case of a depth difference between bdy files and          ! 
     767      ! bathymetry in the case ln_full_vel = .false. and jpk_bdy>0?  ! 
     768      ! [as the enveloping and parital cells could change H          ! 
     769      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     770 
    752771      IF( PRESENT(jpk_bdy) .AND. jpk_bdy>0 ) THEN       ! boundary data not on model grid: vertical interpolation 
    753772         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:jpk_bdy), nrec ) 
     
    764783         END SELECT 
    765784         CALL iom_getatt(num, '_FillValue', fv, cdvar=clvar ) 
     785 
    766786#if defined key_bdy 
    767          CALL fld_bdy_interp(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 
     787         CALL fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl) 
    768788#endif 
    769789      ELSE ! boundary data assumed to be on model grid 
     
    772792            DO ib = 1, ipi 
    773793              DO ik = 1, ipk 
    774                 dta(ib,1,ik) =  dta_read(map(ib),1,ik) 
     794                dta(ib,1,ik) =  dta_read(map%ptr(ib),1,ik) 
    775795              END DO 
    776796            END DO 
    777797         ELSE ! we assume that this is a structured open boundary file 
    778798            DO ib = 1, ipi 
    779                jj=1+floor(REAL(map(ib)-1)/REAL(ilendta)) 
    780                ji=map(ib)-(jj-1)*ilendta 
     799               jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta)) 
     800               ji=map%ptr(ib)-(jj-1)*ilendta 
    781801               DO ik = 1, ipk 
    782802                  dta(ib,1,ik) =  dta_read(ji,jj,ik) 
     
    790810    
    791811#if defined key_bdy 
    792    SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 
     812   SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl) 
    793813 
    794814      !!--------------------------------------------------------------------- 
     
    802822      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in )     ::   dta_read    ! work space for global data 
    803823      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in )     ::   dta_read_z  ! work space for global data 
     824      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in )     ::   dta_read_dz  ! work space for global data 
    804825      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta        ! output field on model grid (2 dimensional) 
    805       INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map        ! global-to-local mapping indices 
     826      TYPE(MAP_POINTER)         , INTENT(in ) ::   map     ! global-to-local mapping indices 
     827      LOGICAL  , INTENT(in), OPTIONAL         ::   fvl  ! grid type, set number and number of vertical levels in the bdy data 
    806828      INTEGER  , INTENT(in)                   ::   igrd, ibdy, jpk_bdy      ! number of levels in bdy data 
    807829      INTEGER                                 ::   jpkm1_bdy    ! number of levels in bdy data minus 1 
     
    810832      INTEGER                                 ::   ipi        ! length of boundary data on local process 
    811833      INTEGER                                 ::   ipj        ! length of dummy dimension ( = 1 ) 
    812       INTEGER                                 ::   ipk, ipkm1 ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     834      INTEGER                                 ::   ipk ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    813835      INTEGER                                 ::   ilendta    ! length of data in file 
    814836      INTEGER                                 ::   ib, ik, ikk! loop counters 
    815837      INTEGER                                 ::   ji, jj ! loop counters 
    816       REAL(wp)                                ::   zl, zi     ! tmp variable for current depth and interpolation factor 
    817       REAL(wp)                                ::   fv_alt ! fillvalue and alternative -ABS(fv) 
     838      REAL(wp)                                ::   zl, zi, zh, zz, zdz    ! tmp variable for current depth and interpolation factor 
     839      REAL(wp)                                ::   fv_alt, ztrans, ztrans_new ! fillvalue and alternative -ABS(fv) 
    818840      !!--------------------------------------------------------------------- 
    819841 
     
    826848      fv_alt = -ABS(fv)  ! set _FillValue < 0 as we make use of MAXVAL and MAXLOC later 
    827849      ! 
    828       IF (ipj==1) THEN ! we assume that this is an un-structured open boundary file 
     850      IF ( map%ll_unstruc ) THEN ! unstructured open boundary data file 
    829851         DO ib = 1, ipi 
    830852            DO ik = 1, jpk_bdy 
    831                IF( ( dta_read(map(ib),1,ik) == fv ) ) THEN 
    832                   dta_read_z(map(ib),1,ik) = fv_alt ! safety: put fillvalue into external depth field so consistent with data 
    833                   dta_read_dz(map(ib),1,ik) = 0._wp ! safety: put 0._wp into external thickness factors to ensure transport is correct 
    834                ENDIF 
    835       !           dta(ib,1,ik) = fv_alt    ! put fillvalue into new field as if all goes well all wet points will be replaced 
     853               IF( ( dta_read(map%ptr(ib),1,ik) == fv ) ) THEN 
     854                  dta_read_z(map%ptr(ib),1,ik) = fv_alt ! safety: put fillvalue into external depth field so consistent with data 
     855                  dta_read_dz(map%ptr(ib),1,ik) = 0._wp ! safety: put 0._wp into external thickness factors to ensure transport is correct 
     856               ENDIF 
    836857            ENDDO 
    837858         ENDDO  
    838       ! 
     859 
    839860         DO ib = 1, ipi 
    840861            DO ik = 1, ipk                       
    841862               zl =  gdept_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_0? 
    842                IF( zl < dta_read_z(map(ib),1,1) ) THEN                                         ! above the first level of external data 
    843                   dta(ib,1,ik) =  dta_read(map(ib),1,1) 
    844                ELSEIF( zl > MAXVAL(dta_read_z(map(ib),1,:),1) ) THEN                           ! below the last level of external data  
    845                   dta(ib,1,ik) =  dta_read(map(ib),1,MAXLOC(dta_read_z(map(ib),1,:),1)) 
     863               IF( zl < dta_read_z(map%ptr(ib),1,1) ) THEN                                         ! above the first level of external data 
     864                  dta(ib,1,ik) =  dta_read(map%ptr(ib),1,1) 
     865               ELSEIF( zl > MAXVAL(dta_read_z(map%ptr(ib),1,:),1) ) THEN                           ! below the last level of external data  
     866                  dta(ib,1,ik) =  dta_read(map%ptr(ib),1,MAXLOC(dta_read_z(map%ptr(ib),1,:),1)) 
    846867               ELSE                                                                          ! inbetween : vertical interpolation between ikk & ikk+1 
    847868                  DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_0(ikk) < zl < gdept_0(ikk+1) 
    848                      IF( ( (zl-dta_read_z(map(ib),1,ikk)) * (zl-dta_read_z(map(ib),1,ikk+1)) <= 0._wp)   & 
    849                     &    .AND. (dta_read_z(map(ib),1,ikk+1) /= fv_alt)) THEN 
    850                         zi = ( zl - dta_read_z(map(ib),1,ikk) ) / (dta_read_z(map(ib),1,ikk+1)-dta_read_z(map(ib),1,ikk)) 
    851                         dta(ib,1,ik) = dta_read(map(ib),1,ikk) + & 
    852                       &                ( dta_read(map(ib),1,ikk+1) -  dta_read(map(ib),1,ikk) ) * zi 
     869                     IF( ( (zl-dta_read_z(map%ptr(ib),1,ikk)) * (zl-dta_read_z(map%ptr(ib),1,ikk+1)) <= 0._wp)   & 
     870                    &    .AND. (dta_read_z(map%ptr(ib),1,ikk+1) /= fv_alt)) THEN 
     871                        zi = ( zl - dta_read_z(map%ptr(ib),1,ikk) ) / (dta_read_z(map%ptr(ib),1,ikk+1)-dta_read_z(map%ptr(ib),1,ikk)) 
     872                        dta(ib,1,ik) = dta_read(map%ptr(ib),1,ikk) + & 
     873                      &                ( dta_read(map%ptr(ib),1,ikk+1) -  dta_read(map%ptr(ib),1,ikk) ) * zi 
    853874                     ENDIF 
    854875                  END DO 
     
    856877            END DO 
    857878         END DO 
    858       ELSE ! we assume that this is a structured open boundary file 
     879 
     880         IF(igrd == 2) THEN ! do we need to adjust the transport term? 
     881           DO ib = 1, ipi 
     882              zh = SUM(dta_read_dz(map%ptr(ib),1,:) ) 
     883              ztrans = 0._wp 
     884              ztrans_new = 0._wp 
     885              DO ik = 1, jpk_bdy 
     886                  ztrans = ztrans + dta_read(map%ptr(ib),1,ik) * dta_read_dz(map%ptr(ib),1,ik) 
     887              ENDDO 
     888              DO ik = 1, ipk 
     889                  zdz =  e3u_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)  
     890                  ztrans_new = ztrans_new + dta(ib,1,ik) * zdz 
     891              ENDDO 
     892              DO ik = 1, ipk 
     893                 zdz =  e3u_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)    
     894                 zz  =  hur(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd))    
     895                 IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
     896                    dta(ib,1,ik) = dta(ib,1,ik) + ( ztrans - ztrans_new ) * ( zdz * zz ) 
     897                 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
     898                    dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * ( zdz * zz ) 
     899                 ENDIF 
     900              ENDDO 
     901            ENDDO 
     902         ENDIF 
     903 
     904         IF(igrd == 3) THEN ! do we need to adjust the transport term? 
     905           DO ib = 1, ipi 
     906              zh = SUM(dta_read_dz(map%ptr(ib),1,:) ) 
     907              ztrans = 0._wp 
     908              ztrans_new = 0._wp 
     909              DO ik = 1, jpk_bdy 
     910                  ztrans = ztrans + dta_read(map%ptr(ib),1,ik) * dta_read_dz(map%ptr(ib),1,ik) 
     911              ENDDO 
     912              DO ik = 1, ipk 
     913                  zdz =  e3v_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)  
     914                  ztrans_new = ztrans_new + dta(ib,1,ik) * zdz 
     915              ENDDO 
     916              DO ik = 1, ipk 
     917                 zdz =  e3v_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)    
     918                 zz  =  hvr(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd))    
     919                 IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
     920                    dta(ib,1,ik) = dta(ib,1,ik) + ( ztrans - ztrans_new ) * ( zdz * zz ) 
     921                 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
     922                    dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * ( zdz * zz ) 
     923                 ENDIF 
     924              ENDDO 
     925            ENDDO 
     926         ENDIF 
     927   
     928         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     929         ! At this point write out a single velocity profile/dz/H for model and input data             ! 
     930         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     931 
     932      ELSE ! structured open boundary file 
    859933         DO ib = 1, ipi 
    860             jj=1+floor(REAL(map(ib)-1)/REAL(ilendta)) 
    861             ji=map(ib)-(jj-1)*ilendta 
     934            jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta)) 
     935            ji=map%ptr(ib)-(jj-1)*ilendta 
    862936            DO ik = 1, jpk_bdy                       
    863937               IF( ( dta_read(ji,jj,ik) == fv ) ) THEN 
    864                   dta_read_z(map(ib),1,ik) = fv_alt ! safety: put fillvalue into external depth field so consistent with data 
     938                  dta_read_z(ji,jj,ik) = fv_alt ! safety: put fillvalue into external depth field so consistent with data 
     939                  dta_read_dz(ji,jj,ik) = 0._wp ! safety: put 0._wp into external thickness factors to ensure transport is correct 
    865940               ENDIF 
    866941     !            dta(ib,1,ik) = fv_alt    ! put fillvalue into new field as if all goes well all wet points will be replaced 
     
    869944      ! 
    870945         DO ib = 1, ipi 
    871             jj=1+floor(REAL(map(ib)-1)/REAL(ilendta)) 
    872             ji=map(ib)-(jj-1)*ilendta 
     946            jj=1+floor(REAL(map%ptr(ib)-1)/REAL(ilendta)) 
     947            ji=map%ptr(ib)-(jj-1)*ilendta 
    873948            DO ik = 1, ipk                       
    874949               zl =  gdept_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_0? 
     
    892967 
    893968   END SUBROUTINE fld_bdy_interp 
    894    SUBROUTINE fld_bdy_conserve(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 
    895  
    896    END SUBROUTINE fld_bdy_conserve 
     969 
     970!  SUBROUTINE fld_bdy_conserve(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 
     971 
     972!  END SUBROUTINE fld_bdy_conserve 
    897973 
    898974#endif 
     
    11931269      INTEGER                           ::   ipk           ! temporary vertical dimension 
    11941270      CHARACTER (len=5)                 ::   aname 
    1195       INTEGER , DIMENSION(3)            ::   ddims 
     1271      INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims 
    11961272      INTEGER , POINTER, DIMENSION(:,:) ::   data_src 
    11971273      REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp 
     
    12161292 
    12171293      !! get dimensions 
     1294      IF ( SIZE(sd%fnow, 3) > 1 ) THEN 
     1295         ALLOCATE( ddims(4) ) 
     1296      ELSE 
     1297         ALLOCATE( ddims(3) ) 
     1298      ENDIF 
    12181299      id = iom_varid( inum, sd%clvar, ddims ) 
    12191300 
     
    13121393         CALL ctl_stop( '    fld_weight : unable to read the file ' ) 
    13131394      ENDIF 
     1395 
     1396      DEALLOCATE (ddims ) 
    13141397 
    13151398      CALL wrk_dealloc( jpi,jpj, data_src )   ! integer 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r5038 r5620  
    1616   USE sbc_oce          ! surface boundary condition: ocean 
    1717# if defined key_lim3 
    18    USE par_ice          ! LIM-3 parameters 
     18   USE ice              ! LIM-3 parameters 
    1919# endif 
    2020# if defined key_lim2 
     
    5858   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2] 
    5959   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice        !: solar heat flux over ice                      [W/m2] 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean   !: daily mean solar heat flux over ice           [W/m2] 
    6160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2] 
    6261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K] 
     
    6968   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-] 
    7069   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-] 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2] 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice          [kg/m2/s] 
    7271 
    7372   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
    7473   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
     74 
     75#if defined  key_lim3 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   evap_ice       !: sublimation                              [kg/m2/s] 
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   devap_ice      !: sublimation sensitivity                [kg/m2/s/K] 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qns_oce        !: non solar heat flux over ocean              [W/m2] 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsr_oce        !: non solar heat flux over ocean              [W/m2] 
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_oce       !: heat flux of precip and evap over ocean     [W/m2] 
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat flux of precip and evap over ice       [W/m2] 
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: heat flux of precip over ice                [J/m3] 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
     84#endif 
     85#if defined key_lim3 || defined key_lim2 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s] 
     87#endif 
    7588 
    7689#if defined key_cice 
     
    100113#endif 
    101114 
    102 #if defined key_lim3 || defined key_cice 
    103    ! not used with LIM2 
     115#if defined key_cice 
    104116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    105117#endif 
     
    125137      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
    126138         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
    127          &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) ,     & 
    128          &      alb_ice (jpi,jpj,jpl) ,                             & 
    129          &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
     139         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) ,   & 
     140         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   & 
    130141         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    131 #if defined key_lim3 
    132          &      tatm_ice(jpi,jpj)     ,                             & 
    133 #endif 
    134142#if defined key_lim2 
    135143         &      a_i(jpi,jpj,jpl)      ,                             & 
     144#endif 
     145#if defined key_lim3 
     146         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,  & 
     147         &      qemp_ice(jpi,jpj)     , qemp_oce(jpi,jpj)      ,                       & 
     148         &      qns_oce (jpi,jpj)     , qsr_oce (jpi,jpj)      , emp_oce (jpi,jpj)  ,  & 
    136149#endif 
    137150         &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) ) 
     
    145158                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
    146159                STAT= ierr(1) ) 
    147       IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     160      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
    148161         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
    149162         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
     
    152165#endif 
    153166         ! 
    154 #if defined key_lim2 
    155       IF( ltrcdm2dc_ice )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 
    156 #endif 
    157          ! 
    158167#if defined key_cice || defined key_lim2 
    159       IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     168      IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
    160169#endif 
    161170 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5038 r5620  
    3636   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
    3737#if defined key_oasis3 
    38    LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation 
     38   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
    3939#else 
    40    LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation 
    41 #endif 
     40   LOGICAL , PUBLIC ::   lk_oasis = .FALSE. !: OASIS unused 
     41#endif 
     42   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation 
     43   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation 
    4244   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr) 
    4345   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths 
     
    5052   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
    5153   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    52    INTEGER , PUBLIC :: nn_limflx        !: LIM3 Multi-category heat flux formulation 
     54   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below)  
     55   INTEGER , PUBLIC ::   nn_limflx      !: LIM3 Multi-category heat flux formulation 
    5356   !                                             !: =-1  Use of per-category fluxes 
    5457   !                                             !: = 0  Average per-category fluxes 
     
    6972   !!           switch definition (improve readability) 
    7073   !!---------------------------------------------------------------------- 
    71    INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation 
    72    INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation 
    73    INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation 
    74    INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation 
    75    INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation 
    76    INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation 
    77    INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation 
     74   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical               formulation 
     75   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical                    formulation 
     76   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk                     formulation 
     78   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk                     formulation 
     79   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation 
     80   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk                     formulation 
     81   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 7        !: for OPA when doing coupling via SAS module 
    7882   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations 
    7983    
    8084   !!---------------------------------------------------------------------- 
     85   !!           component definition 
     86   !!---------------------------------------------------------------------- 
     87   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration  
     88                                                         !  (no internal OASIS coupling) 
     89   INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component 
     90                                                         !  (internal OASIS coupling) 
     91   INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component 
     92                                                         !  (internal OASIS coupling) 
     93   !!---------------------------------------------------------------------- 
    8194   !!              Ocean Surface Boundary Condition fields 
    8295   !!---------------------------------------------------------------------- 
     96   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere 
     97   ! 
    8398   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress) 
    84    LOGICAL , PUBLIC ::   ltrcdm2dc               !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux 
    8599   !!                                   !!   now    ! before   !! 
    86100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2] 
     
    90104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
    91105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2] 
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_mean          !: daily mean sea heat flux: solar              [W/m2] 
    93106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
    94107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2] 
     
    98111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s] 
    99112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s] 
    100    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]   
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]   
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]   
    101115   !! 
    102116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts 
     
    110124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
    111125#endif 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
    112127 
    113128   !!---------------------------------------------------------------------- 
     
    121136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m] 
    122137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m] 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 
    123139 
    124140   !! * Substitutions 
     
    147163         &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) ) 
    148164         ! 
    149       ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 
    150          &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 
     165      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 
     166         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 
    151167         ! 
    152168      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 
     
    154170         &      atm_co2(jpi,jpj) ,                                        & 
    155171#endif 
    156          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) ,                       & 
    157          &      ssv_m  (jpi,jpj) , sss_m  (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) ) 
     172         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      & 
     173         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    158174         ! 
    159175#if defined key_vvl 
    160176      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 
    161177#endif 
    162          ! 
    163       IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) ) 
    164178         ! 
    165179      sbc_oce_alloc = MAXVAL( ierr ) 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    • Property svn:keywords set to Id
    r4792 r5620  
    4343   !!---------------------------------------------------------------------- 
    4444   !! NEMO/OPA 4.0 , NEMO Consortium (2011)  
    45    !! $Id: $ 
     45   !! $Id$ 
    4646   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4747   !!---------------------------------------------------------------------- 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r5038 r5620  
    3434   USE albedo 
    3535   USE prtctl          ! Print control 
    36 #if defined key_lim3 
     36#if defined key_lim3  
    3737   USE ice 
    3838   USE sbc_ice         ! Surface boundary condition: ice fields 
     39   USE limthd_dh       ! for CALL lim_thd_snwblow 
    3940#elif defined key_lim2 
    4041   USE ice_2 
     42   USE sbc_ice         ! Surface boundary condition: ice fields 
     43   USE par_ice_2       ! Surface boundary condition: ice fields 
    4144#endif 
    4245 
     
    4548 
    4649   PUBLIC sbc_blk_clio        ! routine called by sbcmod.F90  
    47    PUBLIC blk_ice_clio        ! routine called by sbcice_lim.F90  
     50#if defined key_lim2 || defined key_lim3 
     51   PUBLIC blk_ice_clio_tau    ! routine called by sbcice_lim.F90  
     52   PUBLIC blk_ice_clio_flx    ! routine called by sbcice_lim.F90  
     53#endif 
    4854 
    4955   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read  
     
    6268   LOGICAL ::   lbulk_init = .TRUE.               ! flag, bulk initialization done or not) 
    6369 
    64 #if ! defined key_lim3                           
    65    ! in namicerun with LIM3 
    6670   REAL(wp) ::   cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM 
    6771   REAL(wp) ::   cao = 1.00e-3 ! chosen by default  ==> should depends on many things...  !!gmto be updated 
    68 #endif 
    6972 
    7073   REAL(wp) ::   rdtbs2      !:    
     
    381384         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius 
    382385      qns(:,:) = qns(:,:) * tmask(:,:,1) 
     386#if defined key_lim3 
     387      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 
     388      qsr_oce(:,:) = qsr(:,:) 
     389#endif 
    383390      ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 
    384391 
    385       CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean 
    386       CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean 
    387       CALL iom_put( "qla_oce", - zqla )   ! output downward latent    heat over the ocean 
    388       CALL iom_put( "qns_oce",   qns  )   ! output downward non solar heat over the ocean 
     392      IF ( nn_ice == 0 ) THEN 
     393         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave  heat over the ocean 
     394         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible  heat over the ocean 
     395         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent    heat over the ocean 
     396         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
     397         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
     398         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
     399         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
     400      ENDIF 
    389401 
    390402      IF(ln_ctl) THEN 
     
    402414   END SUBROUTINE blk_oce_clio 
    403415 
    404  
    405    SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os, palb,  & 
    406       &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    407       &                      p_qla , p_dqns, p_dqla,          & 
    408       &                      p_tpr , p_spr ,                  & 
    409       &                      p_fr1 , p_fr2 , cd_grid, pdim  ) 
     416# if defined key_lim2 || defined key_lim3 
     417   SUBROUTINE blk_ice_clio_tau 
    410418      !!--------------------------------------------------------------------------- 
    411       !!                     ***  ROUTINE blk_ice_clio  *** 
     419      !!                     ***  ROUTINE blk_ice_clio_tau  *** 
     420      !!                  
     421      !!  ** Purpose :   Computation momentum flux at the ice-atm interface   
     422      !!          
     423      !!  ** Method  :   Read utau from a forcing file. Rearrange if C-grid 
     424      !! 
     425      !!---------------------------------------------------------------------- 
     426      REAL(wp) ::   zcoef 
     427      INTEGER  ::   ji, jj   ! dummy loop indices 
     428      !!--------------------------------------------------------------------- 
     429      ! 
     430      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_tau') 
     431 
     432      SELECT CASE( cp_ice_msh ) 
     433 
     434      CASE( 'C' )                          ! C-grid ice dynamics 
     435 
     436         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress 
     437         utau_ice(:,:) = zcoef * utau(:,:) 
     438         vtau_ice(:,:) = zcoef * vtau(:,:) 
     439 
     440      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner) 
     441 
     442         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress 
     443         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point 
     444            DO ji = 2, jpi   ! I-grid : no vector opt. 
     445               utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) ) 
     446               vtau_ice(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) ) 
     447            END DO 
     448         END DO 
     449 
     450         CALL lbc_lnk( utau_ice(:,:), 'I', -1. )   ;   CALL lbc_lnk( vtau_ice(:,:), 'I', -1. )   ! I-point 
     451 
     452      END SELECT 
     453 
     454      IF(ln_ctl) THEN 
     455         CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 
     456      ENDIF 
     457 
     458      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_tau') 
     459 
     460   END SUBROUTINE blk_ice_clio_tau 
     461#endif 
     462 
     463# if defined key_lim2 || defined key_lim3 
     464   SUBROUTINE blk_ice_clio_flx(  ptsu , palb_cs, palb_os, palb ) 
     465      !!--------------------------------------------------------------------------- 
     466      !!                     ***  ROUTINE blk_ice_clio_flx *** 
    412467      !!                  
    413468      !!  ** Purpose :   Computation of the heat fluxes at ocean and snow/ice 
     
    431486      !!                         to take into account solid precip latent heat flux 
    432487      !!---------------------------------------------------------------------- 
    433       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
     488      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   ptsu      ! ice surface temperature                   [Kelvin] 
    434489      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-] 
    435490      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-] 
    436491      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-] 
    437       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2] 
    438       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2] 
    439       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qns    ! non solar heat flux over ice (T-point)      [W/m2] 
    440       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qsr    !     solar heat flux over ice (T-point)      [W/m2] 
    441       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qla    ! latent    heat flux over ice (T-point)      [W/m2] 
    442       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqns   ! non solar heat sensistivity  (T-point)      [W/m2] 
    443       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqla   ! latent    heat sensistivity  (T-point)      [W/m2] 
    444       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s] 
    445       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s] 
    446       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [-] 
    447       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [-] 
    448       CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid) 
    449       INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories 
    450492      !! 
    451493      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    452       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    453       !! 
    454       REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3     ! temporary scalars 
     494      !! 
     495      REAL(wp) ::   zmt1, zmt2, zmt3, ztatm3                    ! temporary scalars 
    455496      REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         - 
    456497      REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         - 
     
    458499      REAL(wp) ::   zcshi, zclei, zrhovaclei, zrhovacshi        !    -         - 
    459500      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
     501      REAL(wp) ::   z1_lsub                                     !    -         - 
    460502      !! 
    461503      REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin 
     
    464506      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density 
    465507      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
     508      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw 
    466509      !!--------------------------------------------------------------------- 
    467510      ! 
    468       IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio') 
     511      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_flx') 
    469512      ! 
    470513      CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
    471       CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    472  
    473       ijpl  = pdim                           ! number of ice categories 
     514      CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 
     515 
    474516      zpatm = 101000.                        ! atmospheric pressure  (assumed constant  here) 
    475  
    476 #if defined key_lim3       
    477       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 
    478 #endif 
    479       !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
    480       !------------------------------------! 
    481       !   momentum fluxes  (utau, vtau )   ! 
    482       !------------------------------------! 
    483  
    484       SELECT CASE( cd_grid ) 
    485       CASE( 'C' )                          ! C-grid ice dynamics 
    486          zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress 
    487          p_taui(:,:) = zcoef * utau(:,:) 
    488          p_tauj(:,:) = zcoef * vtau(:,:) 
    489       CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner) 
    490          zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress 
    491          DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point 
    492             DO ji = 2, jpi   ! I-grid : no vector opt. 
    493                p_taui(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) ) 
    494                p_tauj(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) ) 
    495             END DO 
    496          END DO 
    497          CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point 
    498       END SELECT 
    499  
    500  
     517      !-------------------------------------------------------------------------------- 
    501518      !  Determine cloud optical depths as a function of latitude (Chou et al., 1981). 
    502519      !  and the correction factor for taking into account  the effect of clouds  
    503       !------------------------------------------------------ 
     520      !-------------------------------------------------------------------------------- 
     521 
    504522!CDIR NOVERRCHK 
    505523!CDIR COLLAPSE 
     
    528546            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 
    529547            zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 
    530             p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
     548            sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
    531549               &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s] 
    532550               &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   & 
     
    538556            ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 
    539557            ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    540             p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)  
    541             p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 
    542          END DO 
    543       END DO 
    544       CALL iom_put( 'snowpre', p_spr )   ! Snow precipitation  
     558            fr1_i0(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)  
     559            fr2_i0(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 
     560         END DO 
     561      END DO 
     562      CALL iom_put( 'snowpre', sprecip )   ! Snow precipitation  
    545563       
    546564      !-----------------------------------------------------------! 
    547565      !  snow/ice Shortwave radiation   (abedo already computed)  ! 
    548566      !-----------------------------------------------------------! 
    549       CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 
    550        
    551       DO jl = 1, ijpl 
     567      CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 
     568       
     569      DO jl = 1, jpl 
    552570         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) )   & 
    553571            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) 
     
    555573 
    556574      !                                     ! ========================== ! 
    557       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     575      DO jl = 1, jpl                       !  Loop over ice categories  ! 
    558576         !                                  ! ========================== ! 
    559577!CDIR NOVERRCHK 
     
    569587               ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) )  
    570588               ! 
    571                z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) )  
     589               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) )  
    572590 
    573591               !---------------------------------------- 
     
    576594 
    577595               ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 
    578                zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) ) 
     596               zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) ) 
    579597               ! humidity close to the ice surface (at saturation) 
    580598               zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 
    581599                
    582600               !  computation of intermediate values 
    583                zticemb  = pst(ji,jj,jl) - 7.66 
     601               zticemb  = ptsu(ji,jj,jl) - 7.66 
    584602               zticemb2 = zticemb * zticemb   
    585                ztice3   = pst(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl) 
     603               ztice3   = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 
    586604               zdesidt  = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 ) 
    587605                
     
    596614             
    597615               !  sensible heat flux 
    598                z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) ) 
     616               z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 
    599617             
    600618               !  latent heat flux  
    601                p_qla(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  ) 
     619               qla_ice(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  ) 
    602620               
    603621               !  sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) 
     
    606624               zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )    
    607625               ! 
    608                p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
    609                p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
     626               dqla_ice(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
     627               dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
    610628            END DO 
    611629            ! 
     
    619637      ! 
    620638!CDIR COLLAPSE 
    621       p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    622 !CDIR COLLAPSE 
    623       p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
     639      qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:)      ! Downward Non Solar flux 
     640!CDIR COLLAPSE 
     641      tprecip(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
    624642      ! 
    625643      ! ----------------------------------------------------------------------------- ! 
     
    628646!CDIR COLLAPSE 
    629647      qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with: 
    630          &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip 
    631          &     + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting 
    632          &     - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair 
    633       ! 
     648         &     - sprecip(:,:) * lfus                                                  &   ! remove melting solid precip 
     649         &     + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting 
     650         &     - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair 
     651 
     652#if defined key_lim3 
     653      ! ----------------------------------------------------------------------------- ! 
     654      !    Distribute evapo, precip & associated heat over ice and ocean 
     655      ! ---------------=====--------------------------------------------------------- ! 
     656      CALL wrk_alloc( jpi,jpj, zevap, zsnw )  
     657 
     658      ! --- evaporation --- ! 
     659      z1_lsub = 1._wp / Lsub 
     660      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 
     661      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 
     662      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean 
     663 
     664      ! --- evaporation minus precipitation --- ! 
     665      zsnw(:,:) = 0._wp 
     666      CALL lim_thd_snwblow( pfrld, zsnw )          ! snow redistribution by wind 
     667      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 
     668      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
     669      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
     670 
     671      ! --- heat flux associated with emp --- ! 
     672      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap 
     673         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip 
     674         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip 
     675         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     676      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
     677         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     678 
     679      ! --- total solar and non solar fluxes --- ! 
     680      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
     681      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     682 
     683      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     684      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     685 
     686      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )  
     687#endif 
     688 
    634689!!gm : not necessary as all input data are lbc_lnk... 
    635       CALL lbc_lnk( p_fr1  (:,:) , 'T', 1. ) 
    636       CALL lbc_lnk( p_fr2  (:,:) , 'T', 1. ) 
    637       DO jl = 1, ijpl 
    638          CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. ) 
    639          CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. ) 
    640          CALL lbc_lnk( p_qla (:,:,jl) , 'T', 1. ) 
    641          CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. ) 
     690      CALL lbc_lnk( fr1_i0  (:,:) , 'T', 1. ) 
     691      CALL lbc_lnk( fr2_i0  (:,:) , 'T', 1. ) 
     692      DO jl = 1, jpl 
     693         CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. ) 
     694         CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. ) 
     695         CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. ) 
     696         CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. ) 
    642697      END DO 
    643698 
    644699!!gm : mask is not required on forcing 
    645       DO jl = 1, ijpl 
    646          p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 
    647          p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 
    648          p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1) 
    649          p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1) 
    650       END DO 
     700      DO jl = 1, jpl 
     701         qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1) 
     702         qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1) 
     703         dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1) 
     704         dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1) 
     705      END DO 
     706 
     707      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
     708      CALL wrk_dealloc( jpi,jpj, jpl  , z_qlw, z_qsb ) 
    651709 
    652710      IF(ln_ctl) THEN 
    653          CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=ijpl) 
    654          CALL prt_ctl(tab3d_1=p_qla  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=p_qsr  , clinfo2=' p_qsr  : ', kdim=ijpl) 
    655          CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns  , clinfo2=' p_qns  : ', kdim=ijpl) 
    656          CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst    , clinfo2=' pst    : ', kdim=ijpl) 
    657          CALL prt_ctl(tab2d_1=p_tpr  , clinfo1=' blk_ice_clio: p_tpr  : ', tab2d_2=p_spr  , clinfo2=' p_spr  : ') 
    658          CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 
     711         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=jpl) 
     712         CALL prt_ctl(tab3d_1=qla_ice  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=qsr_ice  , clinfo2=' qsr_ice  : ', kdim=jpl) 
     713         CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice  , clinfo2=' qns_ice  : ', kdim=jpl) 
     714         CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu    , clinfo2=' ptsu    : ', kdim=jpl) 
     715         CALL prt_ctl(tab2d_1=tprecip  , clinfo1=' blk_ice_clio: tprecip  : ', tab2d_2=sprecip  , clinfo2=' sprecip  : ') 
    659716      ENDIF 
    660717 
    661       CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
    662       CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    663       ! 
    664       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio') 
    665       ! 
    666    END SUBROUTINE blk_ice_clio 
    667  
     718      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_flx') 
     719      ! 
     720   END SUBROUTINE blk_ice_clio_flx 
     721 
     722#endif 
    668723 
    669724   SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r5038 r5620  
    2222   !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean 
    2323   !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice 
    24    !!   blk_bio_meanqsr : compute daily mean short wave radiation over the ocean 
    25    !!   blk_ice_meanqsr : compute daily mean short wave radiation over the ice 
    2624   !!   turb_core_2z    : Computes turbulent transfert coefficients 
    2725   !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m 
     
    4644   USE sbc_ice         ! Surface boundary condition: ice fields 
    4745   USE lib_fortran     ! to use key_nosignedzero 
     46#if defined key_lim3 
     47   USE ice, ONLY       : u_ice, v_ice, jpl, pfrld, a_i_b 
     48   USE limthd_dh       ! for CALL lim_thd_snwblow 
     49#elif defined key_lim2 
     50   USE ice_2, ONLY     : u_ice, v_ice 
     51   USE par_ice_2 
     52#endif 
    4853 
    4954   IMPLICIT NONE 
     
    5156 
    5257   PUBLIC   sbc_blk_core         ! routine called in sbcmod module 
    53    PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module 
    54    PUBLIC   blk_ice_meanqsr      ! routine called in sbc_ice_lim module 
     58#if defined key_lim2 || defined key_lim3 
     59   PUBLIC   blk_ice_core_tau     ! routine called in sbc_ice_lim module 
     60   PUBLIC   blk_ice_core_flx     ! routine called in sbc_ice_lim module 
     61#endif 
    5562   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    5663 
     
    195202      !                                            ! compute the surface ocean fluxes using CORE bulk formulea 
    196203      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 
    197  
    198       ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery 
    199       IF( ltrcdm2dc )   CALL blk_bio_meanqsr 
    200204 
    201205#if defined key_cice 
     
    302306      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    303307      ENDIF 
     308 
    304309      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    305310      ! ----------------------------------------------------------------------------- ! 
     
    376381      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    377382         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    378       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar flux 
     383      ! 
     384      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar  
    379385         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
    380386         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
     
    384390         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 
    385391      ! 
    386       CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean 
    387       CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean 
    388       CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean 
    389       CALL iom_put( "qhc_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
    390       CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean 
     392#if defined key_lim3 
     393      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3) 
     394      qsr_oce(:,:) = qsr(:,:) 
     395#endif 
     396      ! 
     397      IF ( nn_ice == 0 ) THEN 
     398         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean 
     399         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean 
     400         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean 
     401         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
     402         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
     403         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
     404         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
     405         tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac   ! output total precipitation [kg/m2/s] 
     406         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac   ! output solid precipitation [kg/m2/s] 
     407         CALL iom_put( 'snowpre', sprecip * 86400. )        ! Snow 
     408         CALL iom_put( 'precip' , tprecip * 86400. )        ! Total precipitation 
     409      ENDIF 
    391410      ! 
    392411      IF(ln_ctl) THEN 
     
    406425  
    407426    
    408    SUBROUTINE blk_ice_core(  pst   , pui   , pvi   , palb ,   & 
    409       &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    410       &                      p_qla , p_dqns, p_dqla,          & 
    411       &                      p_tpr , p_spr ,                  & 
    412       &                      p_fr1 , p_fr2 , cd_grid, pdim  )  
    413       !!--------------------------------------------------------------------- 
    414       !!                     ***  ROUTINE blk_ice_core  *** 
     427#if defined key_lim2 || defined key_lim3 
     428   SUBROUTINE blk_ice_core_tau 
     429      !!--------------------------------------------------------------------- 
     430      !!                     ***  ROUTINE blk_ice_core_tau  *** 
    415431      !! 
    416432      !! ** Purpose :   provide the surface boundary condition over sea-ice 
    417433      !! 
    418       !! ** Method  :   compute momentum, heat and freshwater exchanged 
    419       !!                between atmosphere and sea-ice using CORE bulk 
    420       !!                formulea, ice variables and read atmmospheric fields. 
     434      !! ** Method  :   compute momentum using CORE bulk 
     435      !!                formulea, ice variables and read atmospheric fields. 
    421436      !!                NB: ice drag coefficient is assumed to be a constant 
    422       !!  
    423       !! caution : the net upward water flux has with mm/day unit 
    424       !!--------------------------------------------------------------------- 
    425       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin] 
    426       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    427       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    428       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%] 
    429       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    430       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
    431       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2] 
    432       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2] 
    433       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2] 
    434       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2] 
    435       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2] 
    436       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s] 
    437       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s] 
    438       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%] 
    439       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%] 
    440       CHARACTER(len=1)          , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid) 
    441       INTEGER                   , INTENT(in   ) ::   pdim     ! number of ice categories 
    442       !! 
    443       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    444       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    445       REAL(wp) ::   zst2, zst3 
    446       REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
    447       REAL(wp) ::   zztmp                                        ! temporary variable 
    448       REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
    449       REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    450       !! 
    451       REAL(wp), DIMENSION(:,:)  , POINTER ::   z_wnds_t          ! wind speed ( = | U10m - U_ice | ) at T-point 
    452       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
    453       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
    454       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
    455       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
    456       !!--------------------------------------------------------------------- 
    457       ! 
    458       IF( nn_timing == 1 )  CALL timing_start('blk_ice_core') 
    459       ! 
    460       CALL wrk_alloc( jpi,jpj, z_wnds_t ) 
    461       CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )  
    462  
    463       ijpl  = pdim                            ! number of ice categories 
    464  
     437      !!--------------------------------------------------------------------- 
     438      INTEGER  ::   ji, jj    ! dummy loop indices 
     439      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2 
     440      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f               ! relative wind module and components at F-point 
     441      REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point 
     442      !!--------------------------------------------------------------------- 
     443      ! 
     444      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_tau') 
     445      ! 
    465446      ! local scalars ( place there for vector optimisation purposes) 
    466447      zcoef_wnorm  = rhoa * Cice 
    467448      zcoef_wnorm2 = rhoa * Cice * 0.5 
    468       zcoef_dqlw   = 4.0 * 0.95 * Stef 
    469       zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
    470       zcoef_dqsb   = rhoa * cpa * Cice 
    471449 
    472450!!gm brutal.... 
    473       z_wnds_t(:,:) = 0.e0 
    474       p_taui  (:,:) = 0.e0 
    475       p_tauj  (:,:) = 0.e0 
     451      utau_ice  (:,:) = 0._wp 
     452      vtau_ice  (:,:) = 0._wp 
     453      wndm_ice  (:,:) = 0._wp 
    476454!!gm end 
    477455 
    478 #if defined key_lim3 
    479       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 
    480 #endif 
    481456      ! ----------------------------------------------------------------------------- ! 
    482457      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   ! 
    483458      ! ----------------------------------------------------------------------------- ! 
    484       SELECT CASE( cd_grid ) 
     459      SELECT CASE( cp_ice_msh ) 
    485460      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
    486461         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
     
    489464               ! ... scalar wind at I-point (fld being at T-point) 
    490465               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
    491                   &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pui(ji,jj) 
     466                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj) 
    492467               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
    493                   &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pvi(ji,jj) 
     468                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj) 
    494469               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    495470               ! ... ice stress at I-point 
    496                p_taui(ji,jj) = zwnorm_f * zwndi_f 
    497                p_tauj(ji,jj) = zwnorm_f * zwndj_f 
     471               utau_ice(ji,jj) = zwnorm_f * zwndi_f 
     472               vtau_ice(ji,jj) = zwnorm_f * zwndj_f 
    498473               ! ... scalar wind at T-point (fld being at T-point) 
    499                zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
    500                   &                                                    + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
    501                zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
    502                   &                                                    + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
    503                z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     474               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   & 
     475                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  ) 
     476               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   & 
     477                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  ) 
     478               wndm_ice(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    504479            END DO 
    505480         END DO 
    506          CALL lbc_lnk( p_taui  , 'I', -1. ) 
    507          CALL lbc_lnk( p_tauj  , 'I', -1. ) 
    508          CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
     481         CALL lbc_lnk( utau_ice, 'I', -1. ) 
     482         CALL lbc_lnk( vtau_ice, 'I', -1. ) 
     483         CALL lbc_lnk( wndm_ice, 'T',  1. ) 
    509484         ! 
    510485      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    511486         DO jj = 2, jpj 
    512487            DO ji = fs_2, jpi   ! vect. opt. 
    513                zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
    514                zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
    515                z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     488               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
     489               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
     490               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    516491            END DO 
    517492         END DO 
    518493         DO jj = 2, jpjm1 
    519494            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    520                p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          & 
    521                   &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) ) 
    522                p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          & 
    523                   &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) ) 
     495               utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          & 
     496                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 
     497               vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          & 
     498                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 
    524499            END DO 
    525500         END DO 
    526          CALL lbc_lnk( p_taui  , 'U', -1. ) 
    527          CALL lbc_lnk( p_tauj  , 'V', -1. ) 
    528          CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
     501         CALL lbc_lnk( utau_ice, 'U', -1. ) 
     502         CALL lbc_lnk( vtau_ice, 'V', -1. ) 
     503         CALL lbc_lnk( wndm_ice, 'T',  1. ) 
    529504         ! 
    530505      END SELECT 
     506 
     507      IF(ln_ctl) THEN 
     508         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice_core: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ') 
     509         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice_core: wndm_ice : ') 
     510      ENDIF 
     511 
     512      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_tau') 
     513       
     514   END SUBROUTINE blk_ice_core_tau 
     515 
     516 
     517   SUBROUTINE blk_ice_core_flx( ptsu, palb ) 
     518      !!--------------------------------------------------------------------- 
     519      !!                     ***  ROUTINE blk_ice_core_flx  *** 
     520      !! 
     521      !! ** Purpose :   provide the surface boundary condition over sea-ice 
     522      !! 
     523      !! ** Method  :   compute heat and freshwater exchanged 
     524      !!                between atmosphere and sea-ice using CORE bulk 
     525      !!                formulea, ice variables and read atmmospheric fields. 
     526      !!  
     527      !! caution : the net upward water flux has with mm/day unit 
     528      !!--------------------------------------------------------------------- 
     529      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu          ! sea ice surface temperature 
     530      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb          ! ice albedo (all skies) 
     531      !! 
     532      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     533      REAL(wp) ::   zst2, zst3 
     534      REAL(wp) ::   zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
     535      REAL(wp) ::   zztmp, z1_lsub                               ! temporary variable 
     536      !! 
     537      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
     538      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
     539      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
     540      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
     541      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw       ! evaporation and snw distribution after wind blowing (LIM3) 
     542      !!--------------------------------------------------------------------- 
     543      ! 
     544      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_flx') 
     545      ! 
     546      CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )  
     547 
     548      ! local scalars ( place there for vector optimisation purposes) 
     549      zcoef_dqlw   = 4.0 * 0.95 * Stef 
     550      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
     551      zcoef_dqsb   = rhoa * cpa * Cice 
    531552 
    532553      zztmp = 1. / ( 1. - albo ) 
    533554      !                                     ! ========================== ! 
    534       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     555      DO jl = 1, jpl                        !  Loop over ice categories  ! 
    535556         !                                  ! ========================== ! 
    536557         DO jj = 1 , jpj 
     
    539560               !      I   Radiative FLUXES   ! 
    540561               ! ----------------------------! 
    541                zst2 = pst(ji,jj,jl) * pst(ji,jj,jl) 
    542                zst3 = pst(ji,jj,jl) * zst2 
     562               zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 
     563               zst3 = ptsu(ji,jj,jl) * zst2 
    543564               ! Short Wave (sw) 
    544                p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
     565               qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    545566               ! Long  Wave (lw) 
    546                z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     567               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    547568               ! lw sensitivity 
    548569               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
     
    554575               ! ... turbulent heat fluxes 
    555576               ! Sensible Heat 
    556                z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
     577               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
    557578               ! Latent Heat 
    558                p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
    559                   &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    560                ! Latent heat sensitivity for ice (Dqla/Dt) 
    561                IF( p_qla(ji,jj,jl) > 0._wp ) THEN 
    562                   p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     579               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &                            
     580                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
     581              ! Latent heat sensitivity for ice (Dqla/Dt) 
     582               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
     583                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 
    563584               ELSE 
    564                   p_dqla(ji,jj,jl) = 0._wp 
     585                  dqla_ice(ji,jj,jl) = 0._wp 
    565586               ENDIF 
    566587 
    567588               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    568                z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
     589               z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj) 
    569590 
    570591               ! ----------------------------! 
     
    572593               ! ----------------------------! 
    573594               ! Downward Non Solar flux 
    574                p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl) 
     595               qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl) 
    575596               ! Total non solar heat flux sensitivity for ice 
    576                p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) ) 
     597               dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) 
    577598            END DO 
    578599            ! 
     
    581602      END DO 
    582603      ! 
     604      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
     605      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
     606      CALL iom_put( 'snowpre', sprecip * 86400. )                  ! Snow precipitation 
     607      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation 
     608 
     609#if defined  key_lim3 
     610      CALL wrk_alloc( jpi,jpj, zevap, zsnw )  
     611 
     612      ! --- evaporation --- ! 
     613      z1_lsub = 1._wp / Lsub 
     614      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 
     615      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 
     616      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean 
     617 
     618      ! --- evaporation minus precipitation --- ! 
     619      zsnw(:,:) = 0._wp 
     620      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing  
     621      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
     622      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
     623      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
     624 
     625      ! --- heat flux associated with emp --- ! 
     626      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst 
     627         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
     628         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
     629         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     630      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
     631         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     632 
     633      ! --- total solar and non solar fluxes --- ! 
     634      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
     635      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     636 
     637      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     638      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     639 
     640      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )  
     641#endif 
     642 
    583643      !-------------------------------------------------------------------- 
    584644      ! FRACTIONs of net shortwave radiation which is not absorbed in the 
     
    586646      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    587647      ! 
    588       p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
    589       p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    590       ! 
    591       p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
    592       p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    593       CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation 
    594       CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation 
     648      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     649      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     650      ! 
    595651      ! 
    596652      IF(ln_ctl) THEN 
    597          CALL prt_ctl(tab3d_1=p_qla   , clinfo1=' blk_ice_core: p_qla  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb  : ', kdim=ijpl) 
    598          CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw  : ', tab3d_2=p_dqla  , clinfo2=' p_dqla : ', kdim=ijpl) 
    599          CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw : ', kdim=ijpl) 
    600          CALL prt_ctl(tab3d_1=p_dqns  , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr   , clinfo2=' p_qsr  : ', kdim=ijpl) 
    601          CALL prt_ctl(tab3d_1=pst     , clinfo1=' blk_ice_core: pst    : ', tab3d_2=p_qns   , clinfo2=' p_qns  : ', kdim=ijpl) 
    602          CALL prt_ctl(tab2d_1=p_tpr   , clinfo1=' blk_ice_core: p_tpr  : ', tab2d_2=p_spr   , clinfo2=' p_spr  : ') 
    603          CALL prt_ctl(tab2d_1=p_taui  , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj  , clinfo2=' p_tauj : ') 
    604          CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ') 
    605       ENDIF 
    606  
    607       CALL wrk_dealloc( jpi,jpj,   z_wnds_t ) 
    608       CALL wrk_dealloc( jpi,jpj,   pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    609       ! 
    610       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core') 
    611       ! 
    612    END SUBROUTINE blk_ice_core 
    613  
    614  
    615    SUBROUTINE blk_bio_meanqsr 
    616       !!--------------------------------------------------------------------- 
    617       !!                     ***  ROUTINE blk_bio_meanqsr 
    618       !!                      
    619       !! ** Purpose :   provide daily qsr_mean for PISCES when 
    620       !!                analytic diurnal cycle is applied in physic 
    621       !!                 
    622       !! ** Method  :   add part where there is no ice 
    623       !!  
    624       !!--------------------------------------------------------------------- 
    625       IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr') 
    626       ! 
    627       qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1) 
    628       ! 
    629       IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr') 
    630       ! 
    631    END SUBROUTINE blk_bio_meanqsr 
    632   
    633   
    634    SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim ) 
    635       !!--------------------------------------------------------------------- 
    636       !! 
    637       !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when 
    638       !!                analytic diurnal cycle is applied in physic 
    639       !! 
    640       !! ** Method  :   compute qsr 
    641       !!  
    642       !!--------------------------------------------------------------------- 
    643       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%] 
    644       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2] 
    645       INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories 
    646       ! 
    647       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    648       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    649       REAL(wp) ::   zztmp         ! temporary variable 
    650       !!--------------------------------------------------------------------- 
    651       IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr') 
    652       ! 
    653       ijpl  = pdim                            ! number of ice categories 
    654       zztmp = 1. / ( 1. - albo ) 
    655       !                                     ! ========================== ! 
    656       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    657          !                                  ! ========================== ! 
    658          DO jj = 1 , jpj 
    659             DO ji = 1, jpi 
    660                   p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 
    661             END DO 
    662          END DO 
    663       END DO 
    664       ! 
    665       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr') 
    666       ! 
    667    END SUBROUTINE blk_ice_meanqsr   
    668  
     653         CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_core: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl) 
     654         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw    : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl) 
     655         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb   : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw   : ', kdim=jpl) 
     656         CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice_core: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice  : ', kdim=jpl) 
     657         CALL prt_ctl(tab3d_1=ptsu    , clinfo1=' blk_ice_core: ptsu     : ', tab3d_2=qns_ice , clinfo2=' qns_ice  : ', kdim=jpl) 
     658         CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_core: tprecip  : ', tab2d_2=sprecip , clinfo2=' sprecip  : ') 
     659      ENDIF 
     660 
     661      CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
     662      ! 
     663      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_flx') 
     664       
     665   END SUBROUTINE blk_ice_core_flx 
     666#endif 
    669667 
    670668   SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU,    & 
     
    848846      rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) )   ! If zw10 < 33. => 0, else => 1   
    849847      cd_neutral_10m = 1.e-3 * ( & 
    850          &       (rgt33 + 1._wp)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33. 
     848         &       (1._wp - rgt33)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33. 
    851849         &      + rgt33         *      2.34   )                                                    ! zw10 >= 33. 
    852850      ! 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    • Property svn:keywords set to Id
    r5038 r5620  
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    48    !! $Id: sbcblk_mfs.F90 1730 2009-11-16 14:34:19Z poddo $ 
     48   !! $Id$ 
    4949   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5050   !!---------------------------------------------------------------------- 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5038 r5620  
    2121   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2222   USE sbc_ice         ! Surface boundary condition: ice fields 
     23   USE sbcapr 
    2324   USE sbcdcy          ! surface boundary condition: diurnal cycle 
    2425   USE phycst          ! physical constants 
    2526#if defined key_lim3 
    26    USE par_ice         ! ice parameters 
    2727   USE ice             ! ice variables 
    2828#endif 
     
    3333   USE cpl_oasis3      ! OASIS3 coupling 
    3434   USE geo2ocean       !  
    35    USE oce   , ONLY : tsn, un, vn 
     35   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 
    3636   USE albedo          ! 
    3737   USE in_out_manager  ! I/O manager 
     
    4141   USE timing          ! Timing 
    4242   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     43   USE eosbn2 
     44   USE sbcrnf   , ONLY : l_rnfcpl 
    4345#if defined key_cpl_carbon_cycle 
    4446   USE p4zflx, ONLY : oce_co2 
     
    4749   USE ice_domain_size, only: ncat 
    4850#endif 
     51#if defined key_lim3 
     52   USE limthd_dh       ! for CALL lim_thd_snwblow 
     53#endif 
     54 
    4955   IMPLICIT NONE 
    5056   PRIVATE 
    51 !EM XIOS-OASIS-MCT compliance 
     57 
    5258   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    5359   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
     
    9096   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
    9197   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
    92    INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
    93  
    94    INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
     98   INTEGER, PARAMETER ::   jpr_sflx   = 34            ! salt flux 
     99   INTEGER, PARAMETER ::   jpr_toce   = 35            ! ocean temperature 
     100   INTEGER, PARAMETER ::   jpr_soce   = 36            ! ocean salinity 
     101   INTEGER, PARAMETER ::   jpr_ocx1   = 37            ! ocean current on grid 1 
     102   INTEGER, PARAMETER ::   jpr_ocy1   = 38            ! 
     103   INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height 
     104   INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction           
     105   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
     106   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
     107   INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     108 
     109   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    95110   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    96111   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature 
     
    107122   INTEGER, PARAMETER ::   jps_ivz1   = 14            ! 
    108123   INTEGER, PARAMETER ::   jps_co2    = 15 
    109    INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended 
     124   INTEGER, PARAMETER ::   jps_soce   = 16            ! ocean salinity 
     125   INTEGER, PARAMETER ::   jps_ssh    = 17            ! sea surface height 
     126   INTEGER, PARAMETER ::   jps_qsroce = 18            ! Qsr above the ocean 
     127   INTEGER, PARAMETER ::   jps_qnsoce = 19            ! Qns above the ocean 
     128   INTEGER, PARAMETER ::   jps_oemp   = 20            ! ocean freshwater budget (evap - precip) 
     129   INTEGER, PARAMETER ::   jps_sflx   = 21            ! salt flux 
     130   INTEGER, PARAMETER ::   jps_otx1   = 22            ! 2 atmosphere-ocean stress components on grid 1 
     131   INTEGER, PARAMETER ::   jps_oty1   = 23            !  
     132   INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs 
     133   INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module 
     134   INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 
     135   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
     136   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
     137   INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
    110138 
    111139   !                                                         !!** namelist namsbc_cpl ** 
     
    126154   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
    127155                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    128  
    129    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 
    130  
    131156   TYPE ::   DYNARR      
    132157      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
     
    140165 
    141166   !! Substitution 
     167#  include "domzgr_substitute.h90" 
    142168#  include "vectopt_loop_substitute.h90" 
    143169   !!---------------------------------------------------------------------- 
     
    162188      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    163189#endif 
    164       ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 
     190      ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
    165191      ! 
    166192      sbc_cpl_alloc = MAXVAL( ierr ) 
     
    183209      !!              * initialise the OASIS coupler 
    184210      !!---------------------------------------------------------------------- 
    185       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
     211      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
    186212      !! 
    187213      INTEGER ::   jn   ! dummy loop index 
     
    217243         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    218244         WRITE(numout,*)'~~~~~~~~~~~~' 
     245      ENDIF 
     246      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
    219247         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    220248         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
     
    360388      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    361389      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
     390      CASE( 'none'          )       ! nothing to do 
    362391      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    363392      CASE( 'conservative'  ) 
     
    371400      !                                                      !     Runoffs & Calving     !    
    372401      !                                                      ! ------------------------- ! 
    373       srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
    374 ! This isn't right - really just want ln_rnf_emp changed 
    375 !                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    376 !                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
    377 !                                                 ENDIF 
     402      srcv(jpr_rnf   )%clname = 'O_Runoff' 
     403      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
     404         srcv(jpr_rnf)%laction = .TRUE. 
     405         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
     406         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     407         IF(lwp) WRITE(numout,*) 
     408         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf 
     409      ENDIF 
     410      ! 
    378411      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    379412 
     
    385418      srcv(jpr_qnsmix)%clname = 'O_QnsMix' 
    386419      SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 
     420      CASE( 'none'          )       ! nothing to do 
    387421      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE. 
    388422      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
     
    400434      srcv(jpr_qsrmix)%clname = 'O_QsrMix' 
    401435      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 
     436      CASE( 'none'          )       ! nothing to do 
    402437      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE. 
    403438      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
     
    415450      ! 
    416451      ! non solar sensitivity mandatory for LIM ice model 
    417       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 
     452      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 
    418453         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    419454      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
     
    448483         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    449484      ENDIF 
    450  
    451       ! Allocate all parts of frcv used for received fields 
     485      !                                                      ! ------------------------------- ! 
     486      !                                                      !   OPA-SAS coupling - rcv by opa !    
     487      !                                                      ! ------------------------------- ! 
     488      srcv(jpr_sflx)%clname = 'O_SFLX' 
     489      srcv(jpr_fice)%clname = 'RIceFrc' 
     490      ! 
     491      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 
     492         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     493         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     494         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     495         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 
     496         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point 
     497         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point 
     498         ! Vectors: change of sign at north fold ONLY if on the local grid 
     499         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 
     500         sn_rcv_tau%clvgrd = 'U,V' 
     501         sn_rcv_tau%clvor = 'local grid' 
     502         sn_rcv_tau%clvref = 'spherical' 
     503         sn_rcv_emp%cldes = 'oce only' 
     504         ! 
     505         IF(lwp) THEN                        ! control print 
     506            WRITE(numout,*) 
     507            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     508            WRITE(numout,*)'               OPA component  ' 
     509            WRITE(numout,*) 
     510            WRITE(numout,*)'  received fields from SAS component ' 
     511            WRITE(numout,*)'                  ice cover ' 
     512            WRITE(numout,*)'                  oce only EMP  ' 
     513            WRITE(numout,*)'                  salt flux  ' 
     514            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     515            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     516            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates ' 
     517            WRITE(numout,*)'                  wind stress module' 
     518            WRITE(numout,*) 
     519         ENDIF 
     520      ENDIF 
     521      !                                                      ! -------------------------------- ! 
     522      !                                                      !   OPA-SAS coupling - rcv by sas  !    
     523      !                                                      ! -------------------------------- ! 
     524      srcv(jpr_toce  )%clname = 'I_SSTSST' 
     525      srcv(jpr_soce  )%clname = 'I_SSSal' 
     526      srcv(jpr_ocx1  )%clname = 'I_OCurx1' 
     527      srcv(jpr_ocy1  )%clname = 'I_OCury1' 
     528      srcv(jpr_ssh   )%clname = 'I_SSHght' 
     529      srcv(jpr_e3t1st)%clname = 'I_E3T1st'    
     530      srcv(jpr_fraqsr)%clname = 'I_FraQsr'    
     531      ! 
     532      IF( nn_components == jp_iam_sas ) THEN 
     533         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     534         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     535         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     536         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 
     537         srcv( jpr_e3t1st )%laction = lk_vvl 
     538         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point 
     539         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point 
     540         ! Vectors: change of sign at north fold ONLY if on the local grid 
     541         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 
     542         ! Change first letter to couple with atmosphere if already coupled OPA 
     543         ! this is nedeed as each variable name used in the namcouple must be unique: 
     544         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 
     545         DO jn = 1, jprcv 
     546            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
     547         END DO 
     548         ! 
     549         IF(lwp) THEN                        ! control print 
     550            WRITE(numout,*) 
     551            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     552            WRITE(numout,*)'               SAS component  ' 
     553            WRITE(numout,*) 
     554            IF( .NOT. ln_cpl ) THEN 
     555               WRITE(numout,*)'  received fields from OPA component ' 
     556            ELSE 
     557               WRITE(numout,*)'  Additional received fields from OPA component : ' 
     558            ENDIF 
     559            WRITE(numout,*)'               sea surface temperature (Celcius) ' 
     560            WRITE(numout,*)'               sea surface salinity '  
     561            WRITE(numout,*)'               surface currents '  
     562            WRITE(numout,*)'               sea surface height '  
     563            WRITE(numout,*)'               thickness of first ocean T level '         
     564            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     565            WRITE(numout,*) 
     566         ENDIF 
     567      ENDIF 
     568       
     569      ! =================================================== ! 
     570      ! Allocate all parts of frcv used for received fields ! 
     571      ! =================================================== ! 
    452572      DO jn = 1, jprcv 
    453573         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     
    455575      ! Allocate taum part of frcv which is used even when not received as coupling field 
    456576      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     577      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     578      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     579      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     580      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     581      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    457582      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    458583      IF( k_ice /= 0 ) THEN 
     
    478603      ssnd(jps_tmix)%clname = 'O_TepMix' 
    479604      SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 
    480       CASE( 'none'         )       ! nothing to do 
    481       CASE( 'oce only'             )   ;   ssnd(   jps_toce            )%laction = .TRUE. 
    482       CASE( 'weighted oce and ice' ) 
     605      CASE( 'none'                                 )       ! nothing to do 
     606      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE. 
     607      CASE( 'oce and ice' , 'weighted oce and ice' ) 
    483608         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
    484609         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl 
    485       CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix            )%laction = .TRUE. 
     610      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE. 
    486611      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    487612      END SELECT 
    488       
     613            
    489614      !                                                      ! ------------------------- ! 
    490615      !                                                      !          Albedo           ! 
     
    493618      ssnd(jps_albmix)%clname = 'O_AlbMix' 
    494619      SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 
    495       CASE( 'none'               ! nothing to do 
    496       CASE( 'weighted ice'  )   ;  ssnd(jps_albice)%laction = .TRUE. 
    497       CASE( 'mixed oce-ice' )   ;  ssnd(jps_albmix)%laction = .TRUE. 
     620      CASE( 'none'                 )     ! nothing to do 
     621      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE. 
     622      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE. 
    498623      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 
    499624      END SELECT 
     
    519644         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
    520645      ENDIF 
    521  
     646       
    522647      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    523648      CASE( 'none'         )       ! nothing to do 
     
    526651         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    527652            ssnd(jps_hice:jps_hsnw)%nct = jpl 
    528          ELSE 
    529             IF ( jpl > 1 ) THEN 
    530 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
    531             ENDIF 
    532653         ENDIF 
    533654      CASE ( 'weighted ice and snow' )  
     
    568689      !                                                      ! ------------------------- ! 
    569690      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
     691 
     692      !                                                      ! ------------------------------- ! 
     693      !                                                      !   OPA-SAS coupling - snd by opa !    
     694      !                                                      ! ------------------------------- ! 
     695      ssnd(jps_ssh   )%clname = 'O_SSHght'  
     696      ssnd(jps_soce  )%clname = 'O_SSSal'  
     697      ssnd(jps_e3t1st)%clname = 'O_E3T1st'    
     698      ssnd(jps_fraqsr)%clname = 'O_FraQsr' 
     699      ! 
     700      IF( nn_components == jp_iam_opa ) THEN 
     701         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     702         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 
     703         ssnd( jps_e3t1st )%laction = lk_vvl 
     704         ! vector definition: not used but cleaner... 
     705         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point 
     706         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point 
     707         sn_snd_crt%clvgrd = 'U,V' 
     708         sn_snd_crt%clvor = 'local grid' 
     709         sn_snd_crt%clvref = 'spherical' 
     710         ! 
     711         IF(lwp) THEN                        ! control print 
     712            WRITE(numout,*) 
     713            WRITE(numout,*)'  sent fields to SAS component ' 
     714            WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
     715            WRITE(numout,*)'               sea surface salinity '  
     716            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
     717            WRITE(numout,*)'               sea surface height '  
     718            WRITE(numout,*)'               thickness of first ocean T level '         
     719            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     720            WRITE(numout,*) 
     721         ENDIF 
     722      ENDIF 
     723      !                                                      ! ------------------------------- ! 
     724      !                                                      !   OPA-SAS coupling - snd by sas !    
     725      !                                                      ! ------------------------------- ! 
     726      ssnd(jps_sflx  )%clname = 'I_SFLX'      
     727      ssnd(jps_fice2 )%clname = 'IIceFrc' 
     728      ssnd(jps_qsroce)%clname = 'I_QsrOce'    
     729      ssnd(jps_qnsoce)%clname = 'I_QnsOce'    
     730      ssnd(jps_oemp  )%clname = 'IOEvaMPr'  
     731      ssnd(jps_otx1  )%clname = 'I_OTaux1'    
     732      ssnd(jps_oty1  )%clname = 'I_OTauy1'    
     733      ssnd(jps_rnf   )%clname = 'I_Runoff'    
     734      ssnd(jps_taum  )%clname = 'I_TauMod'    
     735      ! 
     736      IF( nn_components == jp_iam_sas ) THEN 
     737         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     738         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 
     739         ! 
     740         ! Change first letter to couple with atmosphere if already coupled with sea_ice 
     741         ! this is nedeed as each variable name used in the namcouple must be unique: 
     742         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 
     743         DO jn = 1, jpsnd 
     744            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
     745         END DO 
     746         ! 
     747         IF(lwp) THEN                        ! control print 
     748            WRITE(numout,*) 
     749            IF( .NOT. ln_cpl ) THEN 
     750               WRITE(numout,*)'  sent fields to OPA component ' 
     751            ELSE 
     752               WRITE(numout,*)'  Additional sent fields to OPA component : ' 
     753            ENDIF 
     754            WRITE(numout,*)'                  ice cover ' 
     755            WRITE(numout,*)'                  oce only EMP  ' 
     756            WRITE(numout,*)'                  salt flux  ' 
     757            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     758            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     759            WRITE(numout,*)'                  wind stress U,V components' 
     760            WRITE(numout,*)'                  wind stress module' 
     761         ENDIF 
     762      ENDIF 
     763 
    570764      ! 
    571765      ! ================================ ! 
     
    573767      ! ================================ ! 
    574768 
    575       CALL cpl_define(jprcv, jpsnd,nn_cplmodel)             
     769      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
     770       
    576771      IF (ln_usecplmask) THEN  
    577772         xcplmask(:,:,:) = 0. 
     
    583778         xcplmask(:,:,:) = 1. 
    584779      ENDIF 
    585       ! 
    586       IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   & 
     780      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
     781      ! 
     782      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 
     783      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   & 
    587784         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
     785      ncpl_qsr_freq = 86400 / ncpl_qsr_freq 
    588786 
    589787      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
     
    639837      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 
    640838      !!---------------------------------------------------------------------- 
    641       INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    642       INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    643       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    644       !! 
    645       LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module?? 
     839      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index 
     840      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
     841      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
     842 
     843      !! 
     844      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    646845      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    647846      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     
    651850      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    652851      REAL(wp) ::   zzx, zzy               ! temporary variables 
    653       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
     852      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
    654853      !!---------------------------------------------------------------------- 
    655854      ! 
    656855      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    657856      ! 
    658       CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    659       !                                                 ! Receive all the atmos. fields (including ice information) 
    660       isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    661       DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    662          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 
     857      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     858      ! 
     859      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     860      ! 
     861      !                                                      ! ======================================================= ! 
     862      !                                                      ! Receive all the atmos. fields (including ice information) 
     863      !                                                      ! ======================================================= ! 
     864      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges 
     865      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
     866         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
    663867      END DO 
    664868 
     
    720924         ! 
    721925      ENDIF 
    722        
    723926      !                                                      ! ========================= ! 
    724927      !                                                      !    wind stress module     !   (taum) 
     
    749952         ENDIF 
    750953      ENDIF 
    751        
     954      ! 
    752955      !                                                      ! ========================= ! 
    753956      !                                                      !      10 m wind speed      !   (wndm) 
     
    762965!CDIR NOVERRCHK 
    763966               DO ji = 1, jpi  
    764                   wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
     967                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    765968               END DO 
    766969            END DO 
    767970         ENDIF 
    768       ELSE 
    769          IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
    770971      ENDIF 
    771972 
     
    774975      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    775976         ! 
    776          utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
    777          vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
    778          taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     977         IF( ln_mixcpl ) THEN 
     978            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 
     979            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 
     980            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 
     981            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 
     982         ELSE 
     983            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
     984            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
     985            taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     986            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
     987         ENDIF 
    779988         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    780989         !   
     
    782991 
    783992#if defined key_cpl_carbon_cycle 
    784       !                                                              ! atmosph. CO2 (ppm) 
     993      !                                                      ! ================== ! 
     994      !                                                      ! atmosph. CO2 (ppm) ! 
     995      !                                                      ! ================== ! 
    785996      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    786997#endif 
    787998 
     999      !  Fields received by SAS when OASIS coupling 
     1000      !  (arrays no more filled at sbcssm stage) 
     1001      !                                                      ! ================== ! 
     1002      !                                                      !        SSS         ! 
     1003      !                                                      ! ================== ! 
     1004      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1005         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 
     1006         CALL iom_put( 'sss_m', sss_m ) 
     1007      ENDIF 
     1008      !                                                
     1009      !                                                      ! ================== ! 
     1010      !                                                      !        SST         ! 
     1011      !                                                      ! ================== ! 
     1012      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1013         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 
     1014         IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN    ! make sure that sst_m is the potential temperature 
     1015            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 
     1016         ENDIF 
     1017      ENDIF 
     1018      !                                                      ! ================== ! 
     1019      !                                                      !        SSH         ! 
     1020      !                                                      ! ================== ! 
     1021      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1022         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 
     1023         CALL iom_put( 'ssh_m', ssh_m ) 
     1024      ENDIF 
     1025      !                                                      ! ================== ! 
     1026      !                                                      !  surface currents  ! 
     1027      !                                                      ! ================== ! 
     1028      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1029         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
     1030         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1031         CALL iom_put( 'ssu_m', ssu_m ) 
     1032      ENDIF 
     1033      IF( srcv(jpr_ocy1)%laction ) THEN 
     1034         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
     1035         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1036         CALL iom_put( 'ssv_m', ssv_m ) 
     1037      ENDIF 
     1038      !                                                      ! ======================== ! 
     1039      !                                                      !  first T level thickness ! 
     1040      !                                                      ! ======================== ! 
     1041      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling 
     1042         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 
     1043         CALL iom_put( 'e3t_m', e3t_m(:,:) ) 
     1044      ENDIF 
     1045      !                                                      ! ================================ ! 
     1046      !                                                      !  fraction of solar net radiation ! 
     1047      !                                                      ! ================================ ! 
     1048      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling 
     1049         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 
     1050         CALL iom_put( 'frq_m', frq_m ) 
     1051      ENDIF 
     1052       
    7881053      !                                                      ! ========================= ! 
    789       IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case) 
     1054      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case) 
    7901055         !                                                   ! ========================= ! 
    7911056         ! 
    7921057         !                                                       ! total freshwater fluxes over the ocean (emp) 
    793          SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    794          CASE( 'conservative' ) 
    795             emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
    796          CASE( 'oce only', 'oce and ice' ) 
    797             emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
    798          CASE default 
    799             CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
    800          END SELECT 
     1058         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 
     1059            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
     1060            CASE( 'conservative' ) 
     1061               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
     1062            CASE( 'oce only', 'oce and ice' ) 
     1063               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
     1064            CASE default 
     1065               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
     1066            END SELECT 
     1067         ELSE 
     1068            zemp(:,:) = 0._wp 
     1069         ENDIF 
    8011070         ! 
    8021071         !                                                        ! runoffs and calving (added in emp) 
    803          IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    804          IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    805          ! 
    806 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    807 !!gm                                       at least should be optional... 
    808 !!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    809 !!            ! remove negative runoff 
    810 !!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    811 !!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    812 !!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    813 !!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    814 !!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points 
    815 !!               zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    816 !!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    817 !!            ENDIF      
    818 !!            ! add runoff to e-p  
    819 !!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    820 !!         ENDIF 
    821 !!gm  end of internal cooking 
     1072         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1073         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1074          
     1075         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
     1076         ELSE                   ;   emp(:,:) =                              zemp(:,:) 
     1077         ENDIF 
    8221078         ! 
    8231079         !                                                       ! non solar heat flux over the ocean (qns) 
    824          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    825          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1080         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1081         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1082         ELSE                                       ;   zqns(:,:) = 0._wp 
     1083         END IF 
    8261084         ! update qns over the free ocean with: 
    827          qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST) 
    828          IF( srcv(jpr_snow  )%laction )   THEN 
    829               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1085         IF( nn_components /= jp_iam_opa ) THEN 
     1086            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST) 
     1087            IF( srcv(jpr_snow  )%laction ) THEN 
     1088               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1089            ENDIF 
     1090         ENDIF 
     1091         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
     1092         ELSE                   ;   qns(:,:) =                              zqns(:,:) 
    8301093         ENDIF 
    8311094 
    8321095         !                                                       ! solar flux over the ocean          (qsr) 
    833          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
    834          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    835          IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
     1096         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     1097         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1098         ELSE                                       ;   zqsr(:,:) = 0._wp 
     1099         ENDIF 
     1100         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle 
     1101         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 
     1102         ELSE                   ;   qsr(:,:) =                              zqsr(:,:) 
     1103         ENDIF 
    8361104         ! 
    837    
    838       ENDIF 
    839       ! 
    840       CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
     1105         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 
     1106         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1) 
     1107         ! Ice cover  (received by opa in case of opa <-> sas coupling) 
     1108         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 
     1109         ! 
     1110 
     1111      ENDIF 
     1112      ! 
     1113      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
    8411114      ! 
    8421115      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    9351208            ! 
    9361209         ENDIF 
    937  
    9381210         !                                                      ! ======================= ! 
    9391211         !                                                      !     put on ice grid     ! 
     
    10571329    
    10581330 
    1059    SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
     1331   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 
    10601332      !!---------------------------------------------------------------------- 
    10611333      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
     
    10991371      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11001372      ! optional arguments, used only in 'mixed oce-ice' case 
    1101       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
    1102       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius] 
    1103       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1104       ! 
    1105       INTEGER ::   jl   ! dummy loop index 
    1106       REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr 
     1373      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
     1374      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
     1375      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] 
     1376      ! 
     1377      INTEGER ::   jl         ! dummy loop index 
     1378      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk 
     1379      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 
     1380      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice 
     1381      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3 
    11071382      !!---------------------------------------------------------------------- 
    11081383      ! 
    11091384      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    11101385      ! 
    1111       CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 
    1112  
     1386      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1387      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
     1388 
     1389      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
    11131390      zicefr(:,:) = 1.- p_frld(:,:) 
    11141391      zcptn(:,:) = rcp * sst_m(:,:) 
     
    11181395      !                                                      ! ========================= ! 
    11191396      ! 
    1120       !                                                           ! total Precipitations - total Evaporation (emp_tot) 
    1121       !                                                           ! solid precipitation  - sublimation       (emp_ice) 
    1122       !                                                           ! solid Precipitation                      (sprecip) 
     1397      !                                                           ! total Precipitation - total Evaporation (emp_tot) 
     1398      !                                                           ! solid precipitation - sublimation       (emp_ice) 
     1399      !                                                           ! solid Precipitation                     (sprecip) 
     1400      !                                                           ! liquid + solid Precipitation            (tprecip) 
    11231401      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    11241402      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1125          sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
    1126          tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
    1127          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
    1128          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1403         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here 
     1404         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 
     1405         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
     1406         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    11291407            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    11301408         IF( iom_use('hflx_rain_cea') )   & 
     
    11371415            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average) 
    11381416      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    1139          emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    1140          emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
    1141          sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
     1417         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1418         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1419         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
     1420         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
    11421421      END SELECT 
     1422 
     1423      IF( iom_use('subl_ai_cea') )   & 
     1424         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
     1425      !    
     1426      !                                                           ! runoffs and calving (put in emp_tot) 
     1427      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1428      IF( srcv(jpr_cal)%laction ) THEN  
     1429         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1430         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
     1431      ENDIF 
     1432 
     1433      IF( ln_mixcpl ) THEN 
     1434         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
     1435         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 
     1436         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 
     1437         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 
     1438      ELSE 
     1439         emp_tot(:,:) =                                  zemp_tot(:,:) 
     1440         emp_ice(:,:) =                                  zemp_ice(:,:) 
     1441         sprecip(:,:) =                                  zsprecip(:,:) 
     1442         tprecip(:,:) =                                  ztprecip(:,:) 
     1443      ENDIF 
    11431444 
    11441445         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
     
    11471448      IF( iom_use('snow_ai_cea') )   & 
    11481449         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average) 
    1149       IF( iom_use('subl_ai_cea') )   & 
    1150          CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    1151       !    
    1152       !                                                           ! runoffs and calving (put in emp_tot) 
    1153       IF( srcv(jpr_rnf)%laction ) THEN  
    1154          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    1155             CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
    1156          IF( iom_use('hflx_rnf_cea') )   & 
    1157             CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    1158       ENDIF 
    1159       IF( srcv(jpr_cal)%laction ) THEN  
    1160          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1161          CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
    1162       ENDIF 
    1163       ! 
    1164 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    1165 !!gm                                       at least should be optional... 
    1166 !!       ! remove negative runoff                            ! sum over the global domain 
    1167 !!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1168 !!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    1169 !!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    1170 !!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    1171 !!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points 
    1172 !!          zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    1173 !!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    1174 !!       ENDIF      
    1175 !!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
    1176 !! 
    1177 !!gm  end of internal cooking 
    11781450 
    11791451      !                                                      ! ========================= ! 
     
    11811453      !                                                      ! ========================= ! 
    11821454      CASE( 'oce only' )                                     ! the required field is directly provided 
    1183          qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1455         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    11841456      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1185          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1457         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    11861458         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    1187             qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     1459            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
    11881460         ELSE 
    11891461            ! Set all category values equal for the moment 
    11901462            DO jl=1,jpl 
    1191                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1463               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    11921464            ENDDO 
    11931465         ENDIF 
    11941466      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1195          qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1467         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    11961468         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    11971469            DO jl=1,jpl 
    1198                qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
    1199                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     1470               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1471               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
    12001472            ENDDO 
    12011473         ELSE 
     1474            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12021475            DO jl=1,jpl 
    1203                qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    1204                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1476               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1477               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12051478            ENDDO 
    12061479         ENDIF 
    12071480      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    12081481! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    1209          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1210          qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
     1482         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1483         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    12111484            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
    12121485            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    12131486      END SELECT 
    1214       ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 
    1215       qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with: 
    1216          &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
    1217          &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST) 
    1218          &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
    1219       IF( iom_use('hflx_snow_cea') )   & 
    1220          CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    12211487!!gm 
    1222 !!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
     1488!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in  
    12231489!!    the flux that enter the ocean.... 
    12241490!!    moreover 1 - it is not diagnose anywhere....  
     
    12291495      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    12301496         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    1231          qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
     1497         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 
    12321498         IF( iom_use('hflx_cal_cea') )   & 
    12331499            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12341500      ENDIF 
     1501 
     1502      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 
     1503      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1504 
     1505#if defined key_lim3 
     1506      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1507 
     1508      ! --- evaporation --- ! 
     1509      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 
     1510      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 
     1511      !                 but it is incoherent WITH the ice model   
     1512      DO jl=1,jpl 
     1513         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1) 
     1514      ENDDO 
     1515      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 
     1516 
     1517      ! --- evaporation minus precipitation --- ! 
     1518      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 
     1519 
     1520      ! --- non solar flux over ocean --- ! 
     1521      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1522      zqns_oce = 0._wp 
     1523      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
     1524 
     1525      ! --- heat flux associated with emp --- ! 
     1526      zsnw(:,:) = 0._wp 
     1527      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing 
     1528      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap 
     1529         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip 
     1530         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 
     1531      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
     1532         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
     1533 
     1534      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     1535      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1536 
     1537      ! --- total non solar flux --- ! 
     1538      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 
     1539 
     1540      ! --- in case both coupled/forced are active, we must mix values --- !  
     1541      IF( ln_mixcpl ) THEN 
     1542         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 
     1543         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 
     1544         DO jl=1,jpl 
     1545            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1546         ENDDO 
     1547         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 
     1548         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:) 
     1549!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 
     1550      ELSE 
     1551         qns_tot  (:,:  ) = zqns_tot  (:,:  ) 
     1552         qns_oce  (:,:  ) = zqns_oce  (:,:  ) 
     1553         qns_ice  (:,:,:) = zqns_ice  (:,:,:) 
     1554         qprec_ice(:,:)   = zqprec_ice(:,:) 
     1555         qemp_oce (:,:)   = zqemp_oce (:,:) 
     1556      ENDIF 
     1557 
     1558      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1559#else 
     1560 
     1561      ! clem: this formulation is certainly wrong... but better than it was... 
     1562      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with: 
     1563         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
     1564         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST) 
     1565         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
     1566 
     1567     IF( ln_mixcpl ) THEN 
     1568         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1569         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:) 
     1570         DO jl=1,jpl 
     1571            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1572         ENDDO 
     1573      ELSE 
     1574         qns_tot(:,:  ) = zqns_tot(:,:  ) 
     1575         qns_ice(:,:,:) = zqns_ice(:,:,:) 
     1576      ENDIF 
     1577 
     1578#endif 
    12351579 
    12361580      !                                                      ! ========================= ! 
     
    12381582      !                                                      ! ========================= ! 
    12391583      CASE( 'oce only' ) 
    1240          qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1584         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
    12411585      CASE( 'conservative' ) 
    1242          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1586         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12431587         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    1244             qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1588            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
    12451589         ELSE 
    12461590            ! Set all category values equal for the moment 
    12471591            DO jl=1,jpl 
    1248                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1592               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12491593            ENDDO 
    12501594         ENDIF 
    1251          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1252          qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
     1595         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1596         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    12531597      CASE( 'oce and ice' ) 
    1254          qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1598         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
    12551599         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    12561600            DO jl=1,jpl 
    1257                qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
    1258                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1601               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     1602               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
    12591603            ENDDO 
    12601604         ELSE 
     1605            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12611606            DO jl=1,jpl 
    1262                qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    1263                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1607               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1608               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12641609            ENDDO 
    12651610         ENDIF 
    12661611      CASE( 'mixed oce-ice' ) 
    1267          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1612         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12681613! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    12691614!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    12701615!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1271          qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1616         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
    12721617            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
    12731618            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    12741619      END SELECT 
    1275       IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    1276          qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     1620      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle 
     1621         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) ) 
    12771622         DO jl=1,jpl 
    1278             qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 
     1623            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 
    12791624         ENDDO 
     1625      ENDIF 
     1626 
     1627#if defined key_lim3 
     1628      CALL wrk_alloc( jpi,jpj, zqsr_oce )  
     1629      ! --- solar flux over ocean --- ! 
     1630      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1631      zqsr_oce = 0._wp 
     1632      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:) 
     1633 
     1634      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:) 
     1635      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF 
     1636 
     1637      CALL wrk_dealloc( jpi,jpj, zqsr_oce )  
     1638#endif 
     1639 
     1640      IF( ln_mixcpl ) THEN 
     1641         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1642         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:) 
     1643         DO jl=1,jpl 
     1644            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:) 
     1645         ENDDO 
     1646      ELSE 
     1647         qsr_tot(:,:  ) = zqsr_tot(:,:  ) 
     1648         qsr_ice(:,:,:) = zqsr_ice(:,:,:) 
    12801649      ENDIF 
    12811650 
     
    12851654      CASE ('coupled') 
    12861655         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    1287             dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1656            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
    12881657         ELSE 
    12891658            ! Set all category values equal for the moment 
    12901659            DO jl=1,jpl 
    1291                dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1660               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
    12921661            ENDDO 
    12931662         ENDIF 
    12941663      END SELECT 
    1295  
     1664       
     1665      IF( ln_mixcpl ) THEN 
     1666         DO jl=1,jpl 
     1667            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 
     1668         ENDDO 
     1669      ELSE 
     1670         dqns_ice(:,:,:) = zdqns_ice(:,:,:) 
     1671      ENDIF 
     1672       
    12961673      !                                                      ! ========================= ! 
    12971674      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
     
    13091686      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    13101687 
    1311       CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     1688      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1689      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
    13121690      ! 
    13131691      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx') 
     
    13291707      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    13301708      INTEGER ::   isec, info   ! local integer 
     1709      REAL(wp) ::   zumax, zvmax 
    13311710      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    13321711      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
     
    13451724      !                                                      ! ------------------------- ! 
    13461725      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    1347          SELECT CASE( sn_snd_temp%cldes) 
    1348          CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
    1349          CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
    1350             SELECT CASE( sn_snd_temp%clcat ) 
    1351             CASE( 'yes' )    
    1352                ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1353             CASE( 'no' ) 
    1354                ztmp3(:,:,:) = 0.0 
     1726          
     1727         IF ( nn_components == jp_iam_opa ) THEN 
     1728            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 
     1729         ELSE 
     1730            ! we must send the surface potential temperature  
     1731            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     1732            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem) 
     1733            ENDIF 
     1734            ! 
     1735            SELECT CASE( sn_snd_temp%cldes) 
     1736            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1737            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1738               SELECT CASE( sn_snd_temp%clcat ) 
     1739               CASE( 'yes' )    
     1740                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 
     1741               CASE( 'no' ) 
     1742                  WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1743                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1744                  ELSEWHERE 
     1745                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 
     1746                  END WHERE 
     1747               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1748               END SELECT 
     1749            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)    
     1750               SELECT CASE( sn_snd_temp%clcat ) 
     1751               CASE( 'yes' )    
     1752                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1753               CASE( 'no' ) 
     1754                  ztmp3(:,:,:) = 0.0 
     1755                  DO jl=1,jpl 
     1756                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1757                  ENDDO 
     1758               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1759               END SELECT 
     1760            CASE( 'mixed oce-ice'        )    
     1761               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)  
    13551762               DO jl=1,jpl 
    1356                   ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1763                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    13571764               ENDDO 
    1358             CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1765            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13591766            END SELECT 
    1360          CASE( 'mixed oce-ice'        )    
    1361             ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)  
    1362             DO jl=1,jpl 
    1363                ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    1364             ENDDO 
    1365          CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    1366          END SELECT 
     1767         ENDIF 
    13671768         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    13681769         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info ) 
     
    13731774      !                                                      ! ------------------------- ! 
    13741775      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1375          ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1776         SELECT CASE( sn_snd_alb%cldes ) 
     1777         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
     1778         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1779         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 
     1780         END SELECT 
    13761781         CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    13771782      ENDIF 
     
    13861791      !                                                      !  Ice fraction & Thickness !  
    13871792      !                                                      ! ------------------------- ! 
    1388       ! Send ice fraction field  
     1793      ! Send ice fraction field to atmosphere 
    13891794      IF( ssnd(jps_fice)%laction ) THEN 
    13901795         SELECT CASE( sn_snd_thick%clcat ) 
     
    13931798         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    13941799         END SELECT 
    1395          CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1800         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1801      ENDIF 
     1802       
     1803      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 
     1804      IF( ssnd(jps_fice2)%laction ) THEN 
     1805         ztmp3(:,:,1) = fr_i(:,:) 
     1806         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 
    13961807      ENDIF 
    13971808 
     
    14141825            END SELECT 
    14151826         CASE( 'ice and snow'         )    
    1416             ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
    1417             ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1827            SELECT CASE( sn_snd_thick%clcat ) 
     1828            CASE( 'yes' ) 
     1829               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
     1830               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1831            CASE( 'no' ) 
     1832               WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1833                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1834                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1835               ELSEWHERE 
     1836                 ztmp3(:,:,1) = 0. 
     1837                 ztmp4(:,:,1) = 0. 
     1838               END WHERE 
     1839            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1840            END SELECT 
    14181841         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    14191842         END SELECT 
     
    14411864         !                                                              i-1  i   i 
    14421865         !                                                               i      i+1 (for I) 
    1443          SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    1444          CASE( 'oce only'             )      ! C-grid ==> T 
    1445             DO jj = 2, jpjm1 
    1446                DO ji = fs_2, fs_jpim1   ! vector opt. 
    1447                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    1448                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    1449                END DO 
    1450             END DO 
    1451          CASE( 'weighted oce and ice' )    
    1452             SELECT CASE ( cp_ice_msh ) 
    1453             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1866         IF( nn_components == jp_iam_opa ) THEN 
     1867            zotx1(:,:) = un(:,:,1)   
     1868            zoty1(:,:) = vn(:,:,1)   
     1869         ELSE         
     1870            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
     1871            CASE( 'oce only'             )      ! C-grid ==> T 
    14541872               DO jj = 2, jpjm1 
    14551873                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1456                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1457                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
    1458                      zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1459                      zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1874                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     1875                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    14601876                  END DO 
    14611877               END DO 
    1462             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1463                DO jj = 2, jpjm1 
    1464                   DO ji = 2, jpim1   ! NO vector opt. 
    1465                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1466                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1467                      zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1468                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1469                      zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1470                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1878            CASE( 'weighted oce and ice' )    
     1879               SELECT CASE ( cp_ice_msh ) 
     1880               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1881                  DO jj = 2, jpjm1 
     1882                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1883                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1884                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
     1885                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1886                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1887                     END DO 
    14711888                  END DO 
    1472                END DO 
    1473             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1474                DO jj = 2, jpjm1 
    1475                   DO ji = 2, jpim1   ! NO vector opt. 
    1476                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1477                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1478                      zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1479                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1480                      zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1481                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1889               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1890                  DO jj = 2, jpjm1 
     1891                     DO ji = 2, jpim1   ! NO vector opt. 
     1892                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1893                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1894                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1895                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1896                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1897                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1898                     END DO 
    14821899                  END DO 
    1483                END DO 
     1900               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1901                  DO jj = 2, jpjm1 
     1902                     DO ji = 2, jpim1   ! NO vector opt. 
     1903                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1904                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1905                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1906                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1907                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1908                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1909                     END DO 
     1910                  END DO 
     1911               END SELECT 
     1912               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
     1913            CASE( 'mixed oce-ice'        ) 
     1914               SELECT CASE ( cp_ice_msh ) 
     1915               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1916                  DO jj = 2, jpjm1 
     1917                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1918                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
     1919                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1920                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
     1921                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1922                     END DO 
     1923                  END DO 
     1924               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1925                  DO jj = 2, jpjm1 
     1926                     DO ji = 2, jpim1   ! NO vector opt. 
     1927                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1928                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1929                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1930                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1931                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1932                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1933                     END DO 
     1934                  END DO 
     1935               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1936                  DO jj = 2, jpjm1 
     1937                     DO ji = 2, jpim1   ! NO vector opt. 
     1938                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1939                           &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1940                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1941                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1942                           &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1943                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1944                     END DO 
     1945                  END DO 
     1946               END SELECT 
    14841947            END SELECT 
    1485             CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
    1486          CASE( 'mixed oce-ice'        ) 
    1487             SELECT CASE ( cp_ice_msh ) 
    1488             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
    1489                DO jj = 2, jpjm1 
    1490                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1491                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
    1492                         &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1493                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
    1494                         &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    1495                   END DO 
    1496                END DO 
    1497             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1498                DO jj = 2, jpjm1 
    1499                   DO ji = 2, jpim1   ! NO vector opt. 
    1500                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1501                         &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1502                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1503                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1504                         &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1505                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1506                   END DO 
    1507                END DO 
    1508             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1509                DO jj = 2, jpjm1 
    1510                   DO ji = 2, jpim1   ! NO vector opt. 
    1511                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1512                         &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1513                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1514                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1515                         &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1516                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1517                   END DO 
    1518                END DO 
    1519             END SELECT 
    1520          END SELECT 
    1521          CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1948            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1949            ! 
     1950         ENDIF 
    15221951         ! 
    15231952         ! 
     
    15591988      ENDIF 
    15601989      ! 
     1990      ! 
     1991      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 
     1992      !                                                        ! SSH 
     1993      IF( ssnd(jps_ssh )%laction )  THEN 
     1994         !                          ! removed inverse barometer ssh when Patm 
     1995         !                          forcing is used (for sea-ice dynamics) 
     1996         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     1997         ELSE                    ;   ztmp1(:,:) = sshn(:,:) 
     1998         ENDIF 
     1999         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info ) 
     2000 
     2001      ENDIF 
     2002      !                                                        ! SSS 
     2003      IF( ssnd(jps_soce  )%laction )  THEN 
     2004         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 
     2005      ENDIF 
     2006      !                                                        ! first T level thickness  
     2007      IF( ssnd(jps_e3t1st )%laction )  THEN 
     2008         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info ) 
     2009      ENDIF 
     2010      !                                                        ! Qsr fraction 
     2011      IF( ssnd(jps_fraqsr)%laction )  THEN 
     2012         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 
     2013      ENDIF 
     2014      ! 
     2015      !  Fields sent by SAS to OPA when OASIS coupling 
     2016      !                                                        ! Solar heat flux 
     2017      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 
     2018      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 
     2019      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 
     2020      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 
     2021      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 
     2022      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 
     2023      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 
     2024      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 
     2025 
    15612026      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    15622027      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r5038 r5620  
    88   !!            3.0  ! 2006-08  (G. Madec)  Surface module 
    99   !!            3.2  ! 2009-07  (C. Talandier) emp mean s spread over erp area  
     10   !!            3.6  ! 2014-11  (P. Mathiot  ) add ice shelf melting 
    1011   !!---------------------------------------------------------------------- 
    1112 
     
    8889         ! 
    8990         IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) 
    90          ! 
    91          area = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
     91         IF( kn_fwb == 3 .AND. ln_isfcav    )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' ) 
     92         ! 
     93         area = glob_sum( e1e2t(:,:) * tmask(:,:,1))           ! interior global domain surface 
     94         ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes 
     95         ! and in case of no melt, it can generate HSSW. 
    9296         ! 
    9397#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice 
     
    106110            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain 
    107111            zcoef = z_fwf * rcp 
    108             emp(:,:) = emp(:,:) - z_fwf  
    109             qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) ! account for change to the heat budget due to fw correction 
     112            emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1) 
     113            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 
    110114         ENDIF 
    111115         ! 
     
    138142         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes 
    139143            zcoef = fwfold * rcp 
    140             emp(:,:) = emp(:,:) + fwfold 
    141             qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) ! account for change to the heat budget due to fw correction 
     144            emp(:,:) = emp(:,:) + fwfold             * tmask(:,:,1) 
     145            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 
    142146         ENDIF 
    143147         ! 
     
    158162            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 
    159163            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)  
    160             z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area 
     164            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) - snwice_fmass(:,:) ) ) / area 
    161165            !             
    162166            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    • Property svn:keywords set to Id
    r5038 r5620  
    4040# if defined key_cice4 
    4141   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
     42                strocnxT,strocnyT,                               &  
    4243                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     & 
    4344                fresh_gbm,fhocn_gbm,fswthru_gbm,frzmlt,          & 
     
    4849#else 
    4950   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
     51                strocnxT,strocnyT,                               &  
    5052                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,     & 
    5153                fresh_ai,fhocn_ai,fswthru_ai,frzmlt,          & 
     
    9496#  include "domzgr_substitute.h90" 
    9597 
     98   !! $Id$ 
    9699CONTAINS 
    97100 
     
    135138         IF      ( ksbc == jp_flx ) THEN 
    136139            CALL cice_sbc_force(kt) 
    137          ELSE IF ( ksbc == jp_cpl ) THEN 
     140         ELSE IF ( ksbc == jp_purecpl ) THEN 
    138141            CALL sbc_cpl_ice_flx( 1.0-fr_i  ) 
    139142         ENDIF 
     
    143146         CALL cice_sbc_out ( kt, ksbc ) 
    144147 
    145          IF ( ksbc == jp_cpl )  CALL cice_sbc_hadgam(kt+1) 
     148         IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1) 
    146149 
    147150      ENDIF                                          ! End sea-ice time step only 
     
    184187 
    185188! Do some CICE consistency checks 
    186       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
     189      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    187190         IF ( calc_strair .OR. calc_Tsfc ) THEN 
    188191            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
     
    209212 
    210213      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    211       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
     214      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    212215         DO jl=1,ncat 
    213216            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
     
    316319! forced and coupled case  
    317320 
    318       IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
     321      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    319322 
    320323         ztmpn(:,:,:)=0.0 
     
    506509      CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 
    507510 
    508       CALL wrk_dealloc( jpi,jpj, ztmp ) 
     511      CALL wrk_dealloc( jpi,jpj, ztmp, zpice ) 
    509512      CALL wrk_dealloc( jpi,jpj,ncat, ztmpn ) 
    510513      ! 
     
    560563! Combine wind stress and ocean-ice stress 
    561564! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep] 
     565! strocnx and strocny already weighted by ice fraction in CICE so not done here  
    562566 
    563567      utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:) 
    564568      vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)      
     569  
     570! Also need ice/ocean stress on T points so that taum can be updated  
     571! This interpolation is already done in CICE so best to use those values  
     572      CALL cice2nemo(strocnxT,ztmp1,'T',-1.)  
     573      CALL cice2nemo(strocnyT,ztmp2,'T',-1.)  
     574  
     575! Update taum with modulus of ice-ocean stress  
     576! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here  
     577taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1**2. + ztmp2**2.)  
    565578 
    566579! Freshwater fluxes  
     
    574587      ELSE IF (ksbc == jp_core) THEN 
    575588         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    576       ELSE IF (ksbc == jp_cpl) THEN 
     589      ELSE IF (ksbc == jp_purecpl) THEN 
    577590! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
    578591! This is currently as required with the coupling fields from the UM atmosphere 
     
    610623      ENDIF 
    611624! Take into account snow melting except for fully coupled when already in qns_tot 
    612       IF (ksbc == jp_cpl) THEN 
     625      IF (ksbc == jp_purecpl) THEN 
    613626         qsr(:,:)= qsr_tot(:,:) 
    614627         qns(:,:)= qns_tot(:,:) 
     
    645658 
    646659      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    647       IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
     660      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    648661         DO jl=1,ncat 
    649662            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
     
    10831096   !!   Default option           Dummy module         NO CICE sea-ice model 
    10841097   !!---------------------------------------------------------------------- 
     1098   !! $Id$ 
    10851099CONTAINS 
    10861100 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r5038 r5620  
    103103                                 ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 ) 
    104104          
    105          fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
     105         CALL eos_fzp( sss_m(:,:), fr_i(:,:) )       ! sea surface freezing temperature [Celcius] 
     106         fr_i(:,:) = fr_i(:,:) * tmask(:,:,1) 
    106107 
    107          IF( lk_cpl )   a_i(:,:,1) = fr_i(:,:)          
     108         IF( ln_cpl )   a_i(:,:,1) = fr_i(:,:)          
    108109 
    109110         ! Flux and ice fraction computation 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5038 r5620  
    1919   !!---------------------------------------------------------------------- 
    2020   !!   sbc_ice_lim  : sea-ice model time-stepping and update ocean sbc over ice-covered area 
    21    !!   lim_ctl       : alerts in case of ice model crash 
    22    !!   lim_prt_state : ice control print at a given grid point 
    2321   !!---------------------------------------------------------------------- 
    2422   USE oce             ! ocean dynamics and tracers 
    2523   USE dom_oce         ! ocean space and time domain 
    26    USE par_ice         ! sea-ice parameters 
    2724   USE ice             ! LIM-3: ice variables 
    28    USE iceini          ! LIM-3: ice initialisation 
     25   USE thd_ice         ! LIM-3: thermodynamical variables 
    2926   USE dom_ice         ! LIM-3: ice domain 
    3027 
     
    4037   USE limdyn          ! Ice dynamics 
    4138   USE limtrp          ! Ice transport 
     39   USE limhdf          ! Ice horizontal diffusion 
    4240   USE limthd          ! Ice thermodynamics 
    43    USE limitd_th       ! Thermodynamics on ice thickness distribution  
    4441   USE limitd_me       ! Mechanics on ice thickness distribution 
    4542   USE limsbc          ! sea surface boundary condition 
     
    4744   USE limwri          ! Ice outputs 
    4845   USE limrst          ! Ice restarts 
    49    USE limupdate1       ! update of global variables 
    50    USE limupdate2       ! update of global variables 
     46   USE limupdate1      ! update of global variables 
     47   USE limupdate2      ! update of global variables 
    5148   USE limvar          ! Ice variables switch 
     49 
     50   USE limmsh          ! LIM mesh 
     51   USE limistate       ! LIM initial state 
     52   USE limthd_sal      ! LIM ice thermodynamics: salinity 
    5253 
    5354   USE c1d             ! 1D vertical configuration 
     
    6061   USE prtctl          ! Print control 
    6162   USE lib_fortran     !  
    62    USE cpl_oasis3, ONLY : lk_cpl 
     63   USE limctl 
    6364 
    6465#if defined key_bdy  
     
    7071 
    7172   PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90 
    72    PUBLIC lim_prt_state 
     73   PUBLIC sbc_lim_init ! routine called by sbcmod.F90 
    7374    
    7475   !! * Substitutions 
     
    107108      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 
    108109      !! 
    109       INTEGER  ::   ji, jj, jl, jk      ! dummy loop index 
    110       REAL(wp) ::   zcoef   ! local scalar 
     110      INTEGER  ::   jl                 ! dummy loop index 
    111111      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    112112      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice          ! mean ice albedo (for coupled) 
     113      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice  
    113114      !!---------------------------------------------------------------------- 
    114115 
    115116      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
    116117 
    117       IF( kt == nit000 ) THEN 
    118          IF(lwp) WRITE(numout,*) 
    119          IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition'  
    120          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping' 
    121          ! 
    122          CALL ice_init 
    123          ! 
    124          IF( ln_nicep ) THEN      ! control print at a given point 
    125             jiindx = 15    ;   jjindx =  44 
    126             IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 
    127          ENDIF 
    128       ENDIF 
    129  
    130       !                                        !----------------------! 
    131       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  ! 
    132          !                                     !----------------------! 
    133          !                                           !  Bulk Formulae ! 
    134          !                                           !----------------! 
    135          ! 
    136          u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point 
    137          v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)                    ! (C-grid dynamics :  U- & V-points as the ocean) 
    138          ! 
    139          t_bo(:,:) = ( eos_fzp( sss_m ) +  rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) )  ! masked sea surface freezing temperature [Kelvin] 
    140          !                                                                                  ! (set to rt0 over land) 
    141          !                                           ! Ice albedo 
    142          CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )       
    143  
    144          CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    145  
     118      !-----------------------! 
     119      ! --- Ice time step --- ! 
     120      !-----------------------! 
     121      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
     122 
     123         ! mean surface ocean current at ice velocity point (C-grid dynamics :  U- & V-points as the ocean) 
     124         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 
     125         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 
     126          
     127         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
     128         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 
     129         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 
     130           
     131         ! Mask sea ice surface temperature (set to rt0 over land) 
     132         DO jl = 1, jpl 
     133            t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 
     134         END DO      
     135         ! 
     136         !------------------------------------------------!                                            
     137         ! --- Dynamical coupling with the atmosphere --- !                                            
     138         !------------------------------------------------! 
     139         ! It provides the following fields: 
     140         ! utau_ice, vtau_ice : surface ice stress (U- & V-points)   [N/m2] 
     141         !----------------------------------------------------------------- 
    146142         SELECT CASE( kblk ) 
    147          CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
    148  
    149             ! albedo depends on cloud fraction because of non-linear spectral effects 
    150             zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    151             ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    152             ! (zalb_ice) is computed within the bulk routine 
    153              
     143         CASE( jp_clio    )   ;   CALL blk_ice_clio_tau                         ! CLIO bulk formulation             
     144         CASE( jp_core    )   ;   CALL blk_ice_core_tau                         ! CORE bulk formulation 
     145         CASE( jp_purecpl )   ;   CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation 
    154146         END SELECT 
    155147          
    156          !                                           ! Mask sea ice surface temperature 
    157          DO jl = 1, jpl 
    158             t_su(:,:,jl) = t_su(:,:,jl) +  rt0 * ( 1. - tmask(:,:,1) ) 
    159          END DO 
    160       
    161          ! Bulk formulae  - provides the following fields: 
    162          ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2] 
     148         IF( ln_mixcpl) THEN   ! Case of a mixed Bulk/Coupled formulation 
     149            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice) 
     150            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     151            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     152            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     153            CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     154         ENDIF 
     155 
     156         !-------------------------------------------------------! 
     157         ! --- ice dynamics and transport (except in 1D case) ---! 
     158         !-------------------------------------------------------! 
     159         numit = numit + nn_fsbc                  ! Ice model time step 
     160         !                                                    
     161         CALL sbc_lim_bef                         ! Store previous ice values 
     162         CALL sbc_lim_diag0                       ! set diag of mass, heat and salt fluxes to 0 
     163         CALL lim_rst_opn( kt )                   ! Open Ice restart file 
     164         ! 
     165         IF( .NOT. lk_c1d ) THEN 
     166            ! 
     167            CALL lim_dyn( kt )                    ! Ice dynamics    ( rheology/dynamics )    
     168            ! 
     169            CALL lim_trp( kt )                    ! Ice transport   ( Advection/diffusion ) 
     170            ! 
     171            IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 
     172            ! 
     173#if defined key_bdy 
     174            CALL bdy_ice_lim( kt )                ! bdy ice thermo  
     175            IF( ln_icectl )       CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
     176#endif 
     177            ! 
     178            CALL lim_update1( kt )                ! Corrections 
     179            ! 
     180         ENDIF 
     181          
     182         ! previous lead fraction and ice volume for flux calculations 
     183         CALL sbc_lim_bef                         
     184         CALL lim_var_glo2eqv                     ! ht_i and ht_s for ice albedo calculation 
     185         CALL lim_var_agg(1)                      ! at_i for coupling (via pfrld)  
     186         pfrld(:,:)   = 1._wp - at_i(:,:) 
     187         phicif(:,:)  = vt_i(:,:) 
     188          
     189         !------------------------------------------------------!                                            
     190         ! --- Thermodynamical coupling with the atmosphere --- !                                            
     191         !------------------------------------------------------! 
     192         ! It provides the following fields: 
    163193         ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2] 
    164194         ! qla_ice            : latent heat flux over ice              (T-point)         [W/m2] 
     
    166196         ! tprecip , sprecip  : total & solid precipitation            (T-point)         [Kg/m2/s] 
    167197         ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%] 
    168          ! 
     198         !---------------------------------------------------------------------------------------- 
     199         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     200         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
     201 
    169202         SELECT CASE( kblk ) 
    170203         CASE( jp_clio )                                       ! CLIO bulk formulation 
    171             CALL blk_ice_clio( t_su , zalb_cs    , zalb_os    , zalb_ice  ,               & 
    172                &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   & 
    173                &                      qla_ice    , dqns_ice   , dqla_ice  ,               & 
    174                &                      tprecip    , sprecip    ,                           & 
    175                &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  ) 
    176             !          
    177             IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    178                &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    179  
     204            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     205            ! (zalb_ice) is computed within the bulk routine 
     206            CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice ) 
     207            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     208            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    180209         CASE( jp_core )                                       ! CORE bulk formulation 
    181             CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
    182                &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
    183                &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
    184                &                      tprecip   , sprecip   ,                            & 
    185                &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  ) 
    186                ! 
    187             IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    188                &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    189             ! 
    190          CASE ( jp_cpl ) 
    191              
    192             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    193  
    194             ! MV -> seb  
    195 !           CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=t_su    ) 
    196  
    197 !           IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    198 !              &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    199 !           ! Latent heat flux is forced to 0 in coupled : 
    200 !           !  it is included in qns (non-solar heat flux) 
    201 !           qla_ice  (:,:,:) = 0._wp 
    202 !           dqla_ice (:,:,:) = 0._wp 
    203             ! END MV -> seb 
    204             ! 
     210            ! albedo depends on cloud fraction because of non-linear spectral effects 
     211            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     212            CALL blk_ice_core_flx( t_su, zalb_ice ) 
     213            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     214            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     215         CASE ( jp_purecpl ) 
     216            ! albedo depends on cloud fraction because of non-linear spectral effects 
     217            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     218                                 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     219            ! clem: evap_ice is forced to 0 in coupled mode for now  
     220            !       but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models 
     221            evap_ice  (:,:,:) = 0._wp   ;   devap_ice (:,:,:) = 0._wp 
     222            IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    205223         END SELECT 
    206           
    207          !                                           !----------------------! 
    208          !                                           ! LIM-3  time-stepping ! 
    209          !                                           !----------------------! 
    210          !  
    211          numit = numit + nn_fsbc                     ! Ice model time step 
    212          ! 
    213          !                                           ! Store previous ice values 
    214          a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area 
    215          e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy 
    216          v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume 
    217          v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume  
    218          e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy 
    219          smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content 
    220          oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content 
    221          u_ice_b(:,:)     = u_ice(:,:) 
    222          v_ice_b(:,:)     = v_ice(:,:) 
    223  
    224          ! salt, heat and mass fluxes 
    225          sfx    (:,:) = 0._wp   ; 
    226          sfx_bri(:,:) = 0._wp   ;  
    227          sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
    228          sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
    229          sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
    230          sfx_res(:,:) = 0._wp 
    231  
    232          wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
    233          wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
    234          wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp 
    235          wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
    236          wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
    237          wfx_spr(:,:) = 0._wp   ;    
    238  
    239          hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp 
    240          hfx_thd(:,:) = 0._wp   ;    
    241          hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
    242          hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp 
    243          hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp 
    244          hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
    245          hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp  
    246          hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
    247  
    248                           CALL lim_rst_opn( kt )     ! Open Ice restart file 
    249          ! 
    250          IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print 
    251          ! ---------------------------------------------- 
    252          ! ice dynamics and transport (except in 1D case) 
    253          ! ---------------------------------------------- 
    254          IF( .NOT. lk_c1d ) THEN 
    255                           CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
    256                           CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
    257                           CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
    258          IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print 
    259                           CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting) 
    260                           CALL lim_var_agg( 1 )  
    261 #if defined key_bdy 
    262                           ! bdy ice thermo  
    263                           CALL lim_var_glo2eqv            ! equivalent variables 
    264                           CALL bdy_ice_lim( kt ) 
    265                           CALL lim_itd_me_zapsmall 
    266                           CALL lim_var_agg(1) 
    267          IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' )   ! control print 
    268 #endif 
    269                           CALL lim_update1 
    270          ENDIF 
    271 !                         !- Change old values for new values 
    272                           u_ice_b(:,:)     = u_ice(:,:) 
    273                           v_ice_b(:,:)     = v_ice(:,:) 
    274                           a_i_b  (:,:,:)   = a_i  (:,:,:) 
    275                           v_s_b  (:,:,:)   = v_s  (:,:,:) 
    276                           v_i_b  (:,:,:)   = v_i  (:,:,:) 
    277                           e_s_b  (:,:,:,:) = e_s  (:,:,:,:) 
    278                           e_i_b  (:,:,:,:) = e_i  (:,:,:,:) 
    279                           oa_i_b (:,:,:)   = oa_i (:,:,:) 
    280                           smv_i_b(:,:,:)   = smv_i(:,:,:) 
    281   
    282          ! ---------------------------------------------- 
    283          ! ice thermodynamic 
    284          ! ---------------------------------------------- 
    285                           CALL lim_var_glo2eqv            ! equivalent variables 
    286                           CALL lim_var_agg(1)             ! aggregate ice categories 
    287                           ! previous lead fraction and ice volume for flux calculations 
    288                           pfrld(:,:)   = 1._wp - at_i(:,:) 
    289                           phicif(:,:)  = vt_i(:,:) 
    290  
    291                           ! MV -> seb 
    292                           SELECT CASE( kblk ) 
    293                              CASE ( jp_cpl ) 
    294                              CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su    ) 
    295                              IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    296                           &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    297                            ! Latent heat flux is forced to 0 in coupled : 
    298                            !  it is included in qns (non-solar heat flux) 
    299                              qla_ice  (:,:,:) = 0._wp 
    300                              dqla_ice (:,:,:) = 0._wp 
    301                           END SELECT 
    302                           ! END MV -> seb 
    303                           ! 
    304                           CALL lim_var_bv                 ! bulk brine volume (diag) 
    305                           CALL lim_thd( kt )              ! Ice thermodynamics  
    306                           zcoef = rdt_ice /rday           !  Ice natural aging 
    307                           oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 
    308          IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print 
    309                           CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  ! 
    310                           CALL lim_var_agg( 1 )           ! requested by limupdate 
    311                           CALL lim_update2                ! Global variables update 
    312  
    313                           CALL lim_var_glo2eqv            ! equivalent variables (outputs) 
    314                           CALL lim_var_agg(2)             ! aggregate ice thickness categories 
    315          IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 2, ' - Final state - ' )   ! control print 
    316          ! 
    317                           CALL lim_sbc_flx( kt )     ! Update surface ocean mass, heat and salt fluxes 
    318          ! 
    319          IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 3, ' - Final state lim_sbc - ' )   ! control print 
    320          ! 
    321          !                                           ! Diagnostics and outputs  
    322          IF (ln_limdiaout) CALL lim_diahsb 
    323  
    324                           CALL lim_wri( 1  )              ! Ice outputs  
    325  
     224         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     225 
     226         !----------------------------! 
     227         ! --- ice thermodynamics --- ! 
     228         !----------------------------! 
     229         CALL lim_thd( kt )                         ! Ice thermodynamics       
     230         ! 
     231         CALL lim_update2( kt )                     ! Corrections 
     232         ! 
     233         CALL lim_sbc_flx( kt )                     ! Update surface ocean mass, heat and salt fluxes 
     234         ! 
     235         IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs  
     236         ! 
     237         CALL lim_wri( 1 )                          ! Ice outputs  
     238         ! 
    326239         IF( kt == nit000 .AND. ln_rstart )   & 
    327             &             CALL iom_close( numrir )        ! clem: close input ice restart file 
    328          ! 
    329          IF( lrst_ice )   CALL lim_rst_write( kt )        ! Ice restart file  
    330                           CALL lim_var_glo2eqv            ! ??? 
    331          ! 
    332          IF( ln_nicep )   CALL lim_ctl( kt )              ! alerts in case of model crash 
    333          ! 
    334          CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
    335          ! 
    336       ENDIF                                    ! End sea-ice time step only 
    337  
    338       !                                        !--------------------------! 
    339       !                                        !  at all ocean time step  ! 
    340       !                                        !--------------------------! 
    341       !                                                
    342       !                                              ! Update surface ocean stresses (only in ice-dynamic case) 
    343       !                                                   ! otherwise the atm.-ocean stresses are used everywhere 
     240            &             CALL iom_close( numrir )  ! close input ice restart file 
     241         ! 
     242         IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file  
     243         ! 
     244         IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash 
     245         ! 
     246      ENDIF   ! End sea-ice time step only 
     247 
     248      !-------------------------! 
     249      ! --- Ocean time step --- ! 
     250      !-------------------------! 
     251      ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere 
    344252      IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    345253!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    346  
    347       ! 
    348       IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
     254      ! 
     255      IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') 
    349256      ! 
    350257   END SUBROUTINE sbc_ice_lim 
    351258    
     259 
     260   SUBROUTINE sbc_lim_init 
     261      !!---------------------------------------------------------------------- 
     262      !!                  ***  ROUTINE sbc_lim_init  *** 
     263      !! 
     264      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules 
     265      !!---------------------------------------------------------------------- 
     266      INTEGER :: ierr 
     267      !!---------------------------------------------------------------------- 
     268      IF(lwp) WRITE(numout,*) 
     269      IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition'  
     270      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping' 
     271      ! 
     272                                       ! Open the reference and configuration namelist files and namelist output file  
     273      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )  
     274      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
     275      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 
     276 
     277      CALL ice_run                     ! set some ice run parameters 
     278      ! 
     279      !                                ! Allocate the ice arrays 
     280      ierr =        ice_alloc        ()      ! ice variables 
     281      ierr = ierr + dom_ice_alloc    ()      ! domain 
     282      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing 
     283      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics 
     284      ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics 
     285      ! 
     286      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     287      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'sbc_lim_init : unable to allocate ice arrays') 
     288      ! 
     289      !                                ! adequation jpk versus ice/snow layers/categories 
     290      IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   & 
     291         &      CALL ctl_stop( 'STOP',                          & 
     292         &     'sbc_lim_init: the 3rd dimension of workspace arrays is too small.',   & 
     293         &     'use more ocean levels or less ice/snow layers/categories.' ) 
     294      ! 
     295      CALL lim_itd_init                ! ice thickness distribution initialization 
     296      ! 
     297      CALL lim_hdf_init                ! set ice horizontal diffusion computation parameters 
     298      ! 
     299      CALL lim_thd_init                ! set ice thermodynics parameters 
     300      ! 
     301      CALL lim_thd_sal_init            ! set ice salinity parameters 
     302      ! 
     303      CALL lim_msh                     ! ice mesh initialization 
     304      ! 
     305      CALL lim_itd_me_init             ! ice thickness distribution initialization for mecanical deformation 
     306      !                                ! Initial sea-ice state 
     307      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
     308         numit = 0 
     309         numit = nit000 - 1 
     310         CALL lim_istate 
     311      ELSE                                    ! start from a restart file 
     312         CALL lim_rst_read 
     313         numit = nit000 - 1 
     314      ENDIF 
     315      CALL lim_var_agg(1) 
     316      CALL lim_var_glo2eqv 
     317      ! 
     318      CALL lim_sbc_init                 ! ice surface boundary condition    
     319      ! 
     320      fr_i(:,:)     = at_i(:,:)         ! initialisation of sea-ice fraction 
     321      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu 
     322      ! 
     323      nstart = numit  + nn_fsbc       
     324      nitrun = nitend - nit000 + 1  
     325      nlast  = numit  + nitrun  
     326      ! 
     327      IF( nstock == 0 )   nstock = nlast + 1 
     328      ! 
     329   END SUBROUTINE sbc_lim_init 
     330 
     331 
     332   SUBROUTINE ice_run 
     333      !!------------------------------------------------------------------- 
     334      !!                  ***  ROUTINE ice_run *** 
     335      !!                  
     336      !! ** Purpose :   Definition some run parameter for ice model 
     337      !! 
     338      !! ** Method  :   Read the namicerun namelist and check the parameter  
     339      !!              values called at the first timestep (nit000) 
     340      !! 
     341      !! ** input   :   Namelist namicerun 
     342      !!------------------------------------------------------------------- 
     343      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     344      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  & 
     345         &                ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
     346      !!------------------------------------------------------------------- 
     347      !                     
     348      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice 
     349      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 
     350901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 
     351 
     352      REWIND( numnam_ice_cfg )              ! Namelist namicerun in configuration namelist : Parameters for ice 
     353      READ  ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 
     354902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 
     355      IF(lwm) WRITE ( numoni, namicerun ) 
     356      ! 
     357      ! 
     358      IF(lwp) THEN                        ! control print 
     359         WRITE(numout,*) 
     360         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' 
     361         WRITE(numout,*) ' ~~~~~~' 
     362         WRITE(numout,*) '   number of ice  categories                               = ', jpl 
     363         WRITE(numout,*) '   number of ice  layers                                   = ', nlay_i 
     364         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s 
     365         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
     366         WRITE(numout,*) '   maximum ice concentration                               = ', rn_amax  
     367         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
     368         WRITE(numout,*) '   Output   heat/salt budget or not          ln_limdiaout  = ', ln_limdiaout 
     369         WRITE(numout,*) '   control prints in ocean.out for (i,j)=(iiceprt,jiceprt) = ', ln_icectl 
     370         WRITE(numout,*) '   i-index for control prints (ln_icectl=true)             = ', iiceprt 
     371         WRITE(numout,*) '   j-index for control prints (ln_icectl=true)             = ', jiceprt 
     372      ENDIF 
     373      ! 
     374      ! sea-ice timestep and inverse 
     375      rdt_ice   = nn_fsbc * rdttra(1)   
     376      r1_rdtice = 1._wp / rdt_ice  
     377 
     378      ! inverse of nlay_i and nlay_s 
     379      r1_nlay_i = 1._wp / REAL( nlay_i, wp ) 
     380      r1_nlay_s = 1._wp / REAL( nlay_s, wp ) 
     381      ! 
     382#if defined key_bdy 
     383      IF( lwp .AND. ln_limdiahsb )  CALL ctl_warn('online conservation check activated but it does not work with BDY') 
     384#endif 
     385      ! 
     386   END SUBROUTINE ice_run 
     387 
     388 
     389   SUBROUTINE lim_itd_init 
     390      !!------------------------------------------------------------------ 
     391      !!                ***  ROUTINE lim_itd_init *** 
     392      !! 
     393      !! ** Purpose :   Initializes the ice thickness distribution 
     394      !! ** Method  :   ... 
     395      !! ** input   :   Namelist namiceitd 
     396      !!------------------------------------------------------------------- 
     397      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     398      NAMELIST/namiceitd/ nn_catbnd, rn_himean 
     399      ! 
     400      INTEGER  ::   jl                   ! dummy loop index 
     401      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars 
     402      REAL(wp) ::   zhmax, znum, zden, zalpha ! 
     403      !!------------------------------------------------------------------ 
     404      ! 
     405      REWIND( numnam_ice_ref )              ! Namelist namiceitd in reference namelist : Parameters for ice 
     406      READ  ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 
     407903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 
     408 
     409      REWIND( numnam_ice_cfg )              ! Namelist namiceitd in configuration namelist : Parameters for ice 
     410      READ  ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 
     411904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 
     412      IF(lwm) WRITE ( numoni, namiceitd ) 
     413      ! 
     414      ! 
     415      IF(lwp) THEN                        ! control print 
     416         WRITE(numout,*) 
     417         WRITE(numout,*) 'ice_itd : ice cat distribution' 
     418         WRITE(numout,*) ' ~~~~~~' 
     419         WRITE(numout,*) '   shape of ice categories distribution                          nn_catbnd = ', nn_catbnd 
     420         WRITE(numout,*) '   mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 
     421      ENDIF 
     422 
     423      !---------------------------------- 
     424      !- Thickness categories boundaries  
     425      !---------------------------------- 
     426      IF(lwp) WRITE(numout,*) 
     427      IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 
     428      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     429 
     430      hi_max(:) = 0._wp 
     431 
     432      SELECT CASE ( nn_catbnd  )        
     433                                   !---------------------- 
     434         CASE (1)                  ! tanh function (CICE) 
     435                                   !---------------------- 
     436         zc1 =  3._wp / REAL( jpl, wp ) 
     437         zc2 = 10._wp * zc1 
     438         zc3 =  3._wp 
     439 
     440         DO jl = 1, jpl 
     441            zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 
     442            hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 
     443         END DO 
     444 
     445                                   !---------------------- 
     446         CASE (2)                  ! h^(-alpha) function 
     447                                   !---------------------- 
     448         zalpha = 0.05             ! exponent of the transform function 
     449 
     450         zhmax  = 3.*rn_himean 
     451 
     452         DO jl = 1, jpl  
     453            znum = jpl * ( zhmax+1 )**zalpha 
     454            zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl 
     455            hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 
     456         END DO 
     457 
     458      END SELECT 
     459 
     460      DO jl = 1, jpl 
     461         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 
     462      END DO 
     463 
     464      ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl) 
     465      hi_max(jpl) = 99._wp 
     466 
     467      IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 
     468      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 
     469      ! 
     470   END SUBROUTINE lim_itd_init 
     471 
    352472    
    353       SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice,   & 
    354          &                          pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 
     473   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
    355474      !!--------------------------------------------------------------------- 
    356       !!                  ***  ROUTINE sbc_ice_lim  *** 
     475      !!                  ***  ROUTINE ice_lim_flx  *** 
    357476      !!                    
    358477      !! ** Purpose :   update the ice surface boundary condition by averaging and / or 
     
    370489      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux 
    371490      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity 
    372       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqla_ice   ! latent heat flux 
    373       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdql_ice   ! latent heat flux sensitivity 
     491      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pevap_ice  ! sublimation 
     492      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation sensitivity 
    374493      ! 
    375494      INTEGER  ::   jl      ! dummy loop index 
     
    380499      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories 
    381500      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories 
    382       REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_m   ! Mean latent heat flux over all categories 
     501      REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m  ! Mean sublimation over all categories 
    383502      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories 
    384       REAL(wp), POINTER, DIMENSION(:,:) :: z_dql_m   ! Mean d(qla)/dT over all categories 
     503      REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 
    385504      !!---------------------------------------------------------------------- 
    386505 
     
    390509      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==! 
    391510      CASE( 0 , 1 ) 
    392          CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 
    393          ! 
    394          z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 
    395          z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 
    396          z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 
    397          z_qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) ) 
    398          z_dql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) ) 
     511         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
     512         ! 
     513         z_qns_m  (:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 
     514         z_qsr_m  (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 
     515         z_dqn_m  (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 
     516         z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 
     517         z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 
    399518         DO jl = 1, jpl 
    400             pdqn_ice(:,:,jl) = z_dqn_m(:,:) 
    401             pdql_ice(:,:,jl) = z_dql_m(:,:) 
     519            pdqn_ice  (:,:,jl) = z_dqn_m(:,:) 
     520            pdevap_ice(:,:,jl) = z_devap_m(:,:) 
    402521         END DO 
    403522         ! 
    404523         DO jl = 1, jpl 
    405             pqns_ice(:,:,jl) = z_qns_m(:,:) 
    406             pqsr_ice(:,:,jl) = z_qsr_m(:,:) 
    407             pqla_ice(:,:,jl) = z_qla_m(:,:) 
     524            pqns_ice (:,:,jl) = z_qns_m(:,:) 
     525            pqsr_ice (:,:,jl) = z_qsr_m(:,:) 
     526            pevap_ice(:,:,jl) = z_evap_m(:,:) 
    408527         END DO 
    409528         ! 
    410          CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 
     529         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
    411530      END SELECT 
    412531 
     
    418537         ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) )  
    419538         DO jl = 1, jpl 
    420             pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
    421             pqla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
    422             pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )  
     539            pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
     540            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
     541            pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )  
    423542         END DO 
    424543         ! 
     
    429548      ! 
    430549   END SUBROUTINE ice_lim_flx 
    431     
    432     
    433    SUBROUTINE lim_ctl( kt ) 
    434       !!----------------------------------------------------------------------- 
    435       !!                   ***  ROUTINE lim_ctl ***  
    436       !!                  
    437       !! ** Purpose :   Alerts in case of model crash 
    438       !!------------------------------------------------------------------- 
    439       INTEGER, INTENT(in) ::   kt      ! ocean time step 
    440       INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices 
    441       INTEGER  ::   inb_altests       ! number of alert tests (max 20) 
    442       INTEGER  ::   ialert_id         ! number of the current alert 
    443       REAL(wp) ::   ztmelts           ! ice layer melting point 
    444       CHARACTER (len=30), DIMENSION(20)      ::   cl_alname   ! name of alert 
    445       INTEGER           , DIMENSION(20)      ::   inb_alp     ! number of alerts positive 
    446       !!------------------------------------------------------------------- 
    447  
    448       inb_altests = 10 
    449       inb_alp(:)  =  0 
    450  
    451       ! Alert if incompatible volume and concentration 
    452       ialert_id = 2 ! reference number of this alert 
    453       cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert 
    454  
    455       DO jl = 1, jpl 
    456          DO jj = 1, jpj 
    457             DO ji = 1, jpi 
    458                IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN 
    459                   !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    460                   !WRITE(numout,*) ' at_i     ', at_i(ji,jj) 
    461                   !WRITE(numout,*) ' Point - category', ji, jj, jl 
    462                   !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl) 
    463                   !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl) 
    464                   !WRITE(numout,*) ' d_a_i_thd/trp   ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
    465                   !WRITE(numout,*) ' d_v_i_thd/trp   ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 
    466                   inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    467                ENDIF 
    468             END DO 
    469          END DO 
    470       END DO 
    471  
    472       ! Alerte if very thick ice 
    473       ialert_id = 3 ! reference number of this alert 
    474       cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert 
    475       jl = jpl  
    476       DO jj = 1, jpj 
    477          DO ji = 1, jpi 
    478             IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN 
    479                !CALL lim_prt_state( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
    480                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    481             ENDIF 
    482          END DO 
    483       END DO 
    484  
    485       ! Alert if very fast ice 
    486       ialert_id = 4 ! reference number of this alert 
    487       cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert 
    488       DO jj = 1, jpj 
    489          DO ji = 1, jpi 
    490             IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  & 
    491                &  at_i(ji,jj) > 0._wp   ) THEN 
    492                !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' ) 
    493                !WRITE(numout,*) ' ice strength             : ', strength(ji,jj) 
    494                !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj)  
    495                !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj) 
    496                !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj)  
    497                !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj) 
    498                !WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj) 
    499                !WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj) 
    500                !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj) 
    501                !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj) 
    502                !WRITE(numout,*)  
    503                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    504             ENDIF 
    505          END DO 
    506       END DO 
    507  
    508       ! Alert if there is ice on continents 
    509       ialert_id = 6 ! reference number of this alert 
    510       cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert 
    511       DO jj = 1, jpj 
    512          DO ji = 1, jpi 
    513             IF(   tms(ji,jj) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN  
    514                !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' ) 
    515                !WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)  
    516                !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    517                !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    518                !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj) 
    519                !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj) 
    520                !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1) 
    521                !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj) 
    522                !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj) 
    523                ! 
    524                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    525             ENDIF 
    526          END DO 
    527       END DO 
    528  
    529 ! 
    530 !     ! Alert if very fresh ice 
    531       ialert_id = 7 ! reference number of this alert 
    532       cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert 
    533       DO jl = 1, jpl 
    534          DO jj = 1, jpj 
    535             DO ji = 1, jpi 
    536                IF( sm_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    537 !                 CALL lim_prt_state(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' ) 
    538 !                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    539 !                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    540 !                 WRITE(numout,*)  
    541                   inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    542                ENDIF 
    543             END DO 
    544          END DO 
    545       END DO 
    546 ! 
    547  
    548 !     ! Alert if too old ice 
    549       ialert_id = 9 ! reference number of this alert 
    550       cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert 
    551       DO jl = 1, jpl 
    552          DO jj = 1, jpj 
    553             DO ji = 1, jpi 
    554                IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 
    555                       ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 
    556                              ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
    557                   !CALL lim_prt_state( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
    558                   inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    559                ENDIF 
    560             END DO 
    561          END DO 
    562       END DO 
    563   
    564       ! Alert on salt flux 
    565       ialert_id = 5 ! reference number of this alert 
    566       cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert 
    567       DO jj = 1, jpj 
    568          DO ji = 1, jpi 
    569             IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth 
    570                !CALL lim_prt_state( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    571                !DO jl = 1, jpl 
    572                   !WRITE(numout,*) ' Category no: ', jl 
    573                   !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)    
    574                   !WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl)  
    575                   !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)    
    576                   !WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl)  
    577                   !WRITE(numout,*) ' ' 
    578                !END DO 
    579                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    580             ENDIF 
    581          END DO 
    582       END DO 
    583  
    584       ! Alert if qns very big 
    585       ialert_id = 8 ! reference number of this alert 
    586       cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert 
    587       DO jj = 1, jpj 
    588          DO ji = 1, jpi 
    589             IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
    590                ! 
    591                !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
    592                !WRITE(numout,*) ' ji, jj    : ', ji, jj 
    593                !WRITE(numout,*) ' qns       : ', qns(ji,jj) 
    594                !WRITE(numout,*) ' sst       : ', sst_m(ji,jj) 
    595                !WRITE(numout,*) ' sss       : ', sss_m(ji,jj) 
    596                ! 
    597                !CALL lim_prt_state( kt, ji, jj, 2, '   ') 
    598                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    599                ! 
    600             ENDIF 
    601          END DO 
    602       END DO 
    603       !+++++ 
    604   
    605       ! Alert if very warm ice 
    606       ialert_id = 10 ! reference number of this alert 
    607       cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert 
    608       inb_alp(ialert_id) = 0 
    609       DO jl = 1, jpl 
    610          DO jk = 1, nlay_i 
    611             DO jj = 1, jpj 
    612                DO ji = 1, jpi 
    613                   ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rtt 
    614                   IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   & 
    615                      &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
    616                      !WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
    617                      !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 
    618                      !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 
    619                      !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 
    620                      !WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl) 
    621                      !WRITE(numout,*) ' ztmelts : ', ztmelts 
    622                      inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    623                   ENDIF 
    624                END DO 
    625             END DO 
    626          END DO 
    627       END DO 
    628  
    629       ! sum of the alerts on all processors 
    630       IF( lk_mpp ) THEN 
    631          DO ialert_id = 1, inb_altests 
    632             CALL mpp_sum(inb_alp(ialert_id)) 
    633          END DO 
    634       ENDIF 
    635  
    636       ! print alerts 
    637       IF( lwp ) THEN 
    638          ialert_id = 1                                 ! reference number of this alert 
    639          cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert 
    640          WRITE(numout,*) ' time step ',kt 
    641          WRITE(numout,*) ' All alerts at the end of ice model ' 
    642          DO ialert_id = 1, inb_altests 
    643             WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! ' 
    644          END DO 
    645       ENDIF 
    646      ! 
    647    END SUBROUTINE lim_ctl 
    648   
    649     
    650    SUBROUTINE lim_prt_state( kt, ki, kj, kn, cd1 ) 
    651       !!----------------------------------------------------------------------- 
    652       !!                   ***  ROUTINE lim_prt_state ***  
    653       !!                  
    654       !! ** Purpose :   Writes global ice state on the (i,j) point  
    655       !!                in ocean.ouput  
    656       !!                3 possibilities exist  
    657       !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1) 
    658       !!                n = 2    -> exhaustive state 
    659       !!                n = 3    -> ice/ocean salt fluxes 
    660       !! 
    661       !! ** input   :   point coordinates (i,j)  
    662       !!                n : number of the option 
    663       !!------------------------------------------------------------------- 
    664       INTEGER         , INTENT(in) ::   kt            ! ocean time step 
    665       INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices 
    666       CHARACTER(len=*), INTENT(in) ::   cd1           ! 
    667       !! 
    668       INTEGER :: jl, ji, jj 
    669       !!------------------------------------------------------------------- 
    670  
    671       DO ji = mi0(ki), mi1(ki) 
    672          DO jj = mj0(kj), mj1(kj) 
    673  
    674             WRITE(numout,*) ' time step ',kt,' ',cd1             ! print title 
    675  
    676             !---------------- 
    677             !  Simple state 
    678             !---------------- 
    679              
    680             IF ( kn == 1 .OR. kn == -1 ) THEN 
    681                WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 
    682                WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 
    683                WRITE(numout,*) ' Simple state ' 
    684                WRITE(numout,*) ' masks s,u,v   : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 
    685                WRITE(numout,*) ' lat - long    : ', gphit(ji,jj), glamt(ji,jj) 
    686                WRITE(numout,*) ' Time step     : ', numit 
    687                WRITE(numout,*) ' - Ice drift   ' 
    688                WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    689                WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj) 
    690                WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj) 
    691                WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1) 
    692                WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    693                WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    694                WRITE(numout,*) 
    695                WRITE(numout,*) ' - Cell values ' 
    696                WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    697                WRITE(numout,*) ' cell area     : ', area(ji,jj) 
    698                WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
    699                WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
    700                WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)        
    701                DO jl = 1, jpl 
    702                   WRITE(numout,*) ' - Category (', jl,')' 
    703                   WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl) 
    704                   WRITE(numout,*) ' ht_i          : ', ht_i(ji,jj,jl) 
    705                   WRITE(numout,*) ' ht_s          : ', ht_s(ji,jj,jl) 
    706                   WRITE(numout,*) ' v_i           : ', v_i(ji,jj,jl) 
    707                   WRITE(numout,*) ' v_s           : ', v_s(ji,jj,jl) 
    708                   WRITE(numout,*) ' e_s           : ', e_s(ji,jj,1,jl)/1.0e9 
    709                   WRITE(numout,*) ' e_i           : ', e_i(ji,jj,1:nlay_i,jl)/1.0e9 
    710                   WRITE(numout,*) ' t_su          : ', t_su(ji,jj,jl) 
    711                   WRITE(numout,*) ' t_snow        : ', t_s(ji,jj,1,jl) 
    712                   WRITE(numout,*) ' t_i           : ', t_i(ji,jj,1:nlay_i,jl) 
    713                   WRITE(numout,*) ' sm_i          : ', sm_i(ji,jj,jl) 
    714                   WRITE(numout,*) ' smv_i         : ', smv_i(ji,jj,jl) 
    715                   WRITE(numout,*) 
    716                END DO 
    717             ENDIF 
    718             IF( kn == -1 ) THEN 
    719                WRITE(numout,*) ' Mechanical Check ************** ' 
    720                WRITE(numout,*) ' Check what means ice divergence ' 
    721                WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj) 
    722                WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj) 
    723                WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj) 
    724                WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00 
    725             ENDIF 
    726              
    727  
    728             !-------------------- 
    729             !  Exhaustive state 
    730             !-------------------- 
    731              
    732             IF ( kn .EQ. 2 ) THEN 
    733                WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 
    734                WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 
    735                WRITE(numout,*) ' Exhaustive state ' 
    736                WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 
    737                WRITE(numout,*) ' Time step ', numit 
    738                WRITE(numout,*)  
    739                WRITE(numout,*) ' - Cell values ' 
    740                WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    741                WRITE(numout,*) ' cell area     : ', area(ji,jj) 
    742                WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
    743                WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
    744                WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)        
    745                WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj) 
    746                WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj) 
    747                WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ji,jj-1) 
    748                WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    749                WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    750                WRITE(numout,*) ' d_u_ice_dyn   : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn   : ', d_v_ice_dyn(ji,jj) 
    751                WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)   
    752                WRITE(numout,*) 
    753                 
    754                DO jl = 1, jpl 
    755                   WRITE(numout,*) ' - Category (',jl,')' 
    756                   WRITE(numout,*) '   ~~~~~~~~         '  
    757                   WRITE(numout,*) ' ht_i       : ', ht_i(ji,jj,jl)             , ' ht_s       : ', ht_s(ji,jj,jl) 
    758                   WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl) 
    759                   WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl) 
    760                   WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl) 
    761                   WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)    
    762                   WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl)        , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl)  
    763                   WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)    
    764                   WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl)        , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl)  
    765                   WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)   
    766                   WRITE(numout,*) ' d_v_s_trp  : ', d_v_s_trp(ji,jj,jl)        , ' d_v_s_thd  : ', d_v_s_thd(ji,jj,jl) 
    767                   WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9      , ' ei1        : ', e_i_b(ji,jj,1,jl)/1.0e9  
    768                   WRITE(numout,*) ' de_i1_trp  : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd  : ', d_e_i_thd(ji,jj,1,jl)/1.0e9 
    769                   WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9      , ' ei2_b      : ', e_i_b(ji,jj,2,jl)/1.0e9   
    770                   WRITE(numout,*) ' de_i2_trp  : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd  : ', d_e_i_thd(ji,jj,2,jl)/1.0e9 
    771                   WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    772                   WRITE(numout,*) ' d_e_s_trp  : ', d_e_s_trp(ji,jj,1,jl)      , ' d_e_s_thd  : ', d_e_s_thd(ji,jj,1,jl) 
    773                   WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)    
    774                   WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl)      , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl)  
    775                   WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl) 
    776                   WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl)       , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl) 
    777                END DO !jl 
    778                 
    779                WRITE(numout,*) 
    780                WRITE(numout,*) ' - Heat / FW fluxes ' 
    781                WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ ' 
    782                WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 
    783                WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) ) 
    784                WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) ) 
    785                WRITE(numout,*) 
    786                WRITE(numout,*)  
    787                WRITE(numout,*) ' sst        : ', sst_m(ji,jj)   
    788                WRITE(numout,*) ' sss        : ', sss_m(ji,jj)   
    789                WRITE(numout,*)  
    790                WRITE(numout,*) ' - Stresses ' 
    791                WRITE(numout,*) '   ~~~~~~~~ ' 
    792                WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj)  
    793                WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj) 
    794                WRITE(numout,*) ' utau       : ', utau    (ji,jj)  
    795                WRITE(numout,*) ' vtau       : ', vtau    (ji,jj) 
    796                WRITE(numout,*) ' oc. vel. u : ', u_oce   (ji,jj) 
    797                WRITE(numout,*) ' oc. vel. v : ', v_oce   (ji,jj) 
    798             ENDIF 
    799              
    800             !--------------------- 
    801             ! Salt / heat fluxes 
    802             !--------------------- 
    803              
    804             IF ( kn .EQ. 3 ) THEN 
    805                WRITE(numout,*) ' lim_prt_state - Point : ',ji,jj 
    806                WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 
    807                WRITE(numout,*) ' - Salt / Heat Fluxes ' 
    808                WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ ' 
    809                WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 
    810                WRITE(numout,*) ' Time step ', numit 
    811                WRITE(numout,*) 
    812                WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    813                WRITE(numout,*) ' qsr       : ', qsr(ji,jj) 
    814                WRITE(numout,*) ' qns       : ', qns(ji,jj) 
    815                WRITE(numout,*) 
    816                WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 
    817                WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj) 
    818                WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj) 
    819                WRITE(numout,*) ' dhc          : ', diag_heat_dhc(ji,jj)               
    820                WRITE(numout,*) 
    821                WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj) 
    822                WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj) 
    823                WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj) 
    824                WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj)  
    825                WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice 
    826                WRITE(numout,*) 
    827                WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 
    828                WRITE(numout,*) ' emp       : ', emp    (ji,jj) 
    829                WRITE(numout,*) ' sfx       : ', sfx    (ji,jj) 
    830                WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj) 
    831                WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
    832                WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj) 
    833                WRITE(numout,*) 
    834                WRITE(numout,*) ' - Momentum fluxes ' 
    835                WRITE(numout,*) ' utau      : ', utau(ji,jj)  
    836                WRITE(numout,*) ' vtau      : ', vtau(ji,jj) 
    837             ENDIF  
    838             WRITE(numout,*) ' ' 
    839             ! 
    840          END DO 
    841       END DO 
    842       ! 
    843    END SUBROUTINE lim_prt_state 
    844     
     550 
     551   SUBROUTINE sbc_lim_bef 
     552      !!---------------------------------------------------------------------- 
     553      !!                  ***  ROUTINE sbc_lim_bef  *** 
     554      !! 
     555      !! ** purpose :  store ice variables at "before" time step  
     556      !!---------------------------------------------------------------------- 
     557      a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area 
     558      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy 
     559      v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume 
     560      v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume  
     561      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy 
     562      smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content 
     563      oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content 
     564      u_ice_b(:,:)     = u_ice(:,:) 
     565      v_ice_b(:,:)     = v_ice(:,:) 
     566       
     567   END SUBROUTINE sbc_lim_bef 
     568 
     569   SUBROUTINE sbc_lim_diag0 
     570      !!---------------------------------------------------------------------- 
     571      !!                  ***  ROUTINE sbc_lim_diag0  *** 
     572      !! 
     573      !! ** purpose :  set ice-ocean and ice-atm. fluxes to zeros at the beggining 
     574      !!               of the time step 
     575      !!---------------------------------------------------------------------- 
     576      sfx    (:,:) = 0._wp   ; 
     577      sfx_bri(:,:) = 0._wp   ;  
     578      sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
     579      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
     580      sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
     581      sfx_res(:,:) = 0._wp 
     582       
     583      wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
     584      wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
     585      wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp 
     586      wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
     587      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
     588      wfx_spr(:,:) = 0._wp   ;    
     589       
     590      hfx_thd(:,:) = 0._wp   ;    
     591      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
     592      hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp 
     593      hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp 
     594      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
     595      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp  
     596      hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
     597      hfx_err_dif(:,:) = 0._wp   ; 
     598 
     599      afx_tot(:,:) = 0._wp   ; 
     600      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp 
     601 
     602      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp ; 
     603      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp ; 
     604       
     605   END SUBROUTINE sbc_lim_diag0 
     606 
    845607      
    846608   FUNCTION fice_cell_ave ( ptab ) 
     
    853615       
    854616      fice_cell_ave (:,:) = 0.0_wp 
    855        
    856617      DO jl = 1, jpl 
    857          fice_cell_ave (:,:) = fice_cell_ave (:,:) & 
    858             &                  + a_i (:,:,jl) * ptab (:,:,jl) 
     618         fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl) 
    859619      END DO 
    860620       
     
    870630 
    871631      fice_ice_ave (:,:) = 0.0_wp 
    872       WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 
     632      WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 
    873633 
    874634   END FUNCTION fice_ice_ave 
     
    883643      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk 
    884644   END SUBROUTINE sbc_ice_lim 
     645   SUBROUTINE sbc_lim_init                 ! Dummy routine 
     646   END SUBROUTINE sbc_lim_init 
    885647#endif 
    886648 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r5038 r5620  
    101101      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo 
    102102      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K) 
     103      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice  
    103104      !!---------------------------------------------------------------------- 
    104  
    105       CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    106105 
    107106      IF( kt == nit000 ) THEN 
     
    124123         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 
    125124# endif 
     125 
     126         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     127         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
     128 
    126129         !  Bulk Formulea ! 
    127130         !----------------! 
     
    132135               DO ji = 2, jpi   ! NO vector opt. possible 
    133136                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) & 
    134                      &           + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     137                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    135138                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) & 
    136                      &           + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     139                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    137140               END DO 
    138141            END DO 
     
    147150 
    148151         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    149          tfu(:,:) = eos_fzp( sss_m ) +  rt0  
     152         CALL eos_fzp( sss_m(:,:), tfu(:,:) ) 
     153         tfu(:,:) = tfu(:,:) + rt0 
    150154 
    151155         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 
     
    158162 
    159163         SELECT CASE( ksbc ) 
    160          CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
     164         CASE( jp_core , jp_purecpl )   ! CORE and COUPLED bulk formulations 
    161165 
    162166            ! albedo depends on cloud fraction because of non-linear spectral effects 
     
    182186         SELECT CASE( ksbc ) 
    183187         CASE( jp_clio )           ! CLIO bulk formulation 
    184             CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
    185                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    186                &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    187                &                      tprecip    , sprecip    ,                         & 
    188                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
     188!           CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
     189!              &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
     190!              &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
     191!              &                      tprecip    , sprecip    ,                         & 
     192!              &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
     193            CALL blk_ice_clio_tau 
     194            CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 
    189195 
    190196         CASE( jp_core )           ! CORE bulk formulation 
    191             CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            & 
    192                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    193                &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    194                &                      tprecip    , sprecip    ,                         & 
    195                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    196             IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 
    197  
    198          CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
     197            CALL blk_ice_core_tau 
     198            CALL blk_ice_core_flx( zsist, zalb_ice ) 
     199 
     200         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    199201            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    200202         END SELECT 
     203          
     204         IF( ln_mixcpl) THEN 
     205            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     206            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     207            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     208         ENDIF 
    201209 
    202210         CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point 
     
    228236         END IF 
    229237         !                                             ! Ice surface fluxes in coupled mode  
    230          IF( ksbc == jp_cpl )   THEN 
     238         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations 
    231239            a_i(:,:,1)=fr_i 
    232240            CALL sbc_cpl_ice_flx( frld,                                              & 
    233241            !                                optional arguments, used only in 'mixed oce-ice' case 
    234             &                                             palbi = zalb_ice, psst = sst_m, pist = zsist ) 
     242            &                                             palbi=zalb_ice, psst=sst_m, pist=zsist ) 
    235243            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
    236244         ENDIF 
    237245                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    238246                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes  
    239 #if defined key_top 
    240         IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2 
    241 #endif 
    242247 
    243248         IF(  .NOT. lk_mpp )THEN 
     
    253258         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt ) 
    254259# endif 
     260         ! 
     261         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     262         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    255263         ! 
    256264      ENDIF                                    ! End sea-ice time step only 
     
    264272      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    265273      ! 
    266       CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    267       ! 
    268274   END SUBROUTINE sbc_ice_lim_2 
    269275 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    • Property svn:keywords set to Id
    r5038 r5620  
    77   !! History :  3.2   !  2011-02  (C.Harris  ) Original code isf cav 
    88   !!            X.X   !  2006-02  (C. Wang   ) Original code bg03 
    9    !!            3.4   !  2013-03  (P. Mathiot) Merging 
     9   !!            3.4   !  2013-03  (P. Mathiot) Merging + parametrization 
    1010   !!---------------------------------------------------------------------- 
    1111 
     
    3737 
    3838   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   risf_tsc_b, risf_tsc    
    39    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fwfisf_b, fwfisf  !: evaporation damping   [kg/m2/s] 
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf            !: net heat flux from ice shelf 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qisf              !: net heat flux from ice shelf 
    4140   REAL(wp), PUBLIC ::   rn_hisf_tbl                 !: thickness of top boundary layer [m] 
    4241   LOGICAL , PUBLIC ::   ln_divisf                   !: flag to correct divergence  
     
    8180   !!---------------------------------------------------------------------- 
    8281   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
    83    !! $Id: sbcice_if.F90 1730 2009-11-16 14:34:19Z smasson $ 
     82   !! $Id$ 
    8483   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    8584   !!---------------------------------------------------------------------- 
     
    309308      sbc_isf_alloc = 0       ! set to zero if no array to be allocated 
    310309      IF( .NOT. ALLOCATED( qisf ) ) THEN 
    311          ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts)              , & 
    312                &    qisf(jpi,jpj)     , fwfisf(jpi,jpj)     , fwfisf_b(jpi,jpj)   , & 
    313                &    rhisf_tbl(jpi,jpj), r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj)  , & 
    314                &    ttbl(jpi,jpj)     , stbl(jpi,jpj)       , utbl(jpi,jpj)       , & 
    315                &    vtbl(jpi, jpj)    , risfLeff(jpi,jpj)   , rhisf_tbl_0(jpi,jpj), & 
    316                &    ralpha(jpi,jpj)   , misfkt(jpi,jpj)     , misfkb(jpi,jpj)     , & 
     310         ALLOCATE(  risf_tsc(jpi,jpj,jpts), risf_tsc_b(jpi,jpj,jpts), qisf(jpi,jpj)   , & 
     311               &    rhisf_tbl(jpi,jpj)    , r1_hisf_tbl(jpi,jpj), rzisf_tbl(jpi,jpj)  , & 
     312               &    ttbl(jpi,jpj)         , stbl(jpi,jpj)       , utbl(jpi,jpj)       , & 
     313               &    vtbl(jpi, jpj)        , risfLeff(jpi,jpj)   , rhisf_tbl_0(jpi,jpj), & 
     314               &    ralpha(jpi,jpj)       , misfkt(jpi,jpj)     , misfkb(jpi,jpj)     , & 
    317315               &    STAT= sbc_isf_alloc ) 
    318316         ! 
     
    372370             ! Calculate freezing temperature 
    373371                zpress = grav*rau0*fsdept(ji,jj,ik)*1.e-04  
    374                 zt_frz = eos_fzp(tsb(ji,jj,ik,jp_sal), zpress)  
     372                CALL eos_fzp(tsb(ji,jj,ik,jp_sal), zt_frz, zpress)  
    375373                zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik)  ! sum temp 
    376374             ENDDO 
     
    454452      zti(:,:)=tinsitu( ttbl, stbl, zpress ) 
    455453! Calculate freezing temperature 
    456       zfrz(:,:)=eos_fzp( sss_m(:,:), zpress ) 
     454      CALL eos_fzp( sss_m(:,:), zfrz(:,:), zpress ) 
    457455 
    458456       
     
    563561      CALL iom_put('isfgammat', zgammat2d) 
    564562      CALL iom_put('isfgammas', zgammas2d) 
    565          ! 
    566       !CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zqisf, zfwfisf  ) 
     563      ! 
    567564      CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d ) 
    568565      ! 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5038 r5620  
    1313   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    1414   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes 
     15   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting                     
    1516   !!---------------------------------------------------------------------- 
    1617 
     
    2324   USE phycst           ! physical constants 
    2425   USE sbc_oce          ! Surface boundary condition: ocean fields 
     26   USE trc_oce          ! shared ocean-passive tracers variables 
    2527   USE sbc_ice          ! Surface boundary condition: ice fields 
    2628   USE sbcdcy           ! surface boundary condition: diurnal cycle 
     
    3739   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3840   USE sbccpl           ! surface boundary condition: coupled florulation 
     41   USE cpl_oasis3       ! OASIS routines for coupling 
    3942   USE sbcssr           ! surface boundary condition: sea surface restoring 
    4043   USE sbcrnf           ! surface boundary condition: runoffs 
     
    5053   USE timing           ! Timing 
    5154   USE sbcwave          ! Wave module 
     55   USE bdy_par          ! Require lk_bdy 
    5256 
    5357   IMPLICIT NONE 
     
    8286      INTEGER ::   icpt   ! local integer 
    8387      !! 
    84       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    85          &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    86          &             ln_ssr    ,  nn_isf , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
     88      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl,   & 
     89         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   & 
     90         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   & 
     91         &             nn_lsm    , nn_limflx , nn_components, ln_cpl 
    8792      INTEGER  ::   ios 
     93      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm 
     94      LOGICAL  ::   ll_purecpl 
    8895      !!---------------------------------------------------------------------- 
    8996 
     
    113120          nn_ice      =   0 
    114121      ENDIF 
    115       
     122 
    116123      IF(lwp) THEN               ! Control print 
    117124         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
     
    123130         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    124131         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    125          WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
     132         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl 
     133         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl 
     134         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis 
     135         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components 
    126136         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    127137         WRITE(numout,*) '           Misc. options of sbc : ' 
     
    150160      END SELECT 
    151161      ! 
    152 #if defined key_top && ! defined key_offline 
    153       ltrcdm2dc = (ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2) 
    154       IF( ltrcdm2dc )THEN 
    155          IF(lwp)THEN 
    156             WRITE(numout,*)"analytical diurnal cycle, core bulk formulation and LIM2 use: " 
    157             WRITE(numout,*)"Diurnal cycle on physics but not in passive tracers" 
    158          ENDIF 
    159       ENDIF 
    160 #else  
    161       ltrcdm2dc =  .FALSE. 
    162 #endif 
    163  
    164       ! 
     162      IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   & 
     163         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     164      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   & 
     165         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 
     166      IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   & 
     167         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     168      IF ( ln_cpl .AND. .NOT. lk_oasis )    & 
     169         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 
     170      IF( ln_mixcpl .AND. .NOT. lk_oasis )    & 
     171         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 
     172      IF( ln_mixcpl .AND. .NOT. ln_cpl )    & 
     173         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 
     174      IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    & 
     175         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 
     176 
    165177      !                              ! allocate sbc arrays 
    166178      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) 
    167179 
    168180      !                          ! Checks: 
    169       IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths  
    170          ln_rnf_mouth  = .false.                       
    171          IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' ) 
    172          nkrnf         = 0 
    173          rnf     (:,:) = 0.0_wp 
    174          rnf_b   (:,:) = 0.0_wp 
    175          rnfmsk  (:,:) = 0.0_wp 
    176          rnfmsk_z(:)   = 0.0_wp 
    177       ENDIF 
    178       IF( nn_isf .EQ. 0 ) THEN                      ! no specific treatment in vicinity of ice shelf  
     181      IF( nn_isf .EQ. 0 ) THEN                      ! variable initialisation if no ice shelf  
    179182         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 
    180183         fwfisf  (:,:) = 0.0_wp 
     184         fwfisf_b(:,:) = 0.0_wp 
     185         rdivisf       = 0.0_wp 
    181186      END IF 
    182       IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero 
     187      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 
    183188 
    184189      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
     
    190195 
    191196      !                                            ! restartability    
    192       IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
    193           MOD( nstock             , nn_fsbc) /= 0 ) THEN  
    194          WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
    195             &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
    196          CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
    197       ENDIF 
    198       ! 
    199       IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
    200          &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    201       ! 
    202       IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
     197      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   & 
    203198         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
    204       IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
    205          &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
     199      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   & 
     200         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 
    206201      IF( nn_ice == 4 .AND. lk_agrif )   & 
    207202         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
     
    210205      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
    211206         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
    212       IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     207      IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
    213208         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
    214       IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     209      IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) )   & 
    215210         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
    216211 
    217212      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    218213 
    219       IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   & 
     214      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   & 
    220215         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 
    221216       
    222       IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
    223          &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    224  
    225217      IF ( ln_wave ) THEN 
    226218      !Activated wave module but neither drag nor stokes drift activated 
     
    236228         & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ') 
    237229      ENDIF  
    238        
    239230      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
     231      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 
     232      ! 
    240233      icpt = 0 
    241       IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
    242       IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
    243       IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    244       IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    245       IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    246       IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    247       IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation 
    248       IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations 
     234      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation 
     235      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
     236      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation 
     237      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core    ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk            formulation 
     238      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation 
     239      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
     240      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation 
     241      IF( nn_components == jp_iam_opa )   & 
     242         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
     243      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations 
    249244      ! 
    250245      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
     
    257252      IF(lwp) THEN 
    258253         WRITE(numout,*) 
    259          IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
    260          IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation' 
    261          IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation' 
    262          IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation' 
    263          IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation' 
    264          IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation' 
    265          IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation' 
    266          IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation' 
    267       ENDIF 
    268       ! 
     254         IF( nsbc == jp_esopa   )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
     255         IF( nsbc == jp_gyre    )   WRITE(numout,*) '              GYRE analytical formulation' 
     256         IF( nsbc == jp_ana     )   WRITE(numout,*) '              analytical formulation' 
     257         IF( nsbc == jp_flx     )   WRITE(numout,*) '              flux formulation' 
     258         IF( nsbc == jp_clio    )   WRITE(numout,*) '              CLIO bulk formulation' 
     259         IF( nsbc == jp_core    )   WRITE(numout,*) '              CORE bulk formulation' 
     260         IF( nsbc == jp_purecpl )   WRITE(numout,*) '              pure coupled formulation' 
     261         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation' 
     262         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis' 
     263         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation' 
     264         IF( nn_components/= jp_iam_nemo )  & 
     265            &                       WRITE(numout,*) '              + OASIS coupled SAS' 
     266      ENDIF 
     267      ! 
     268      IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
     269      !                                                     !                                            (2) the use of nn_fsbc 
     270 
     271!     nn_fsbc initialization if OPA-SAS coupling via OASIS 
     272!     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
     273      IF ( nn_components /= jp_iam_nemo ) THEN 
     274 
     275         IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 
     276         IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 
     277         ! 
     278         IF(lwp)THEN 
     279            WRITE(numout,*) 
     280            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 
     281            WRITE(numout,*) 
     282         ENDIF 
     283      ENDIF 
     284 
     285      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
     286          MOD( nstock             , nn_fsbc) /= 0 ) THEN  
     287         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
     288            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
     289         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
     290      ENDIF 
     291      ! 
     292      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
     293         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
     294      ! 
     295      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
     296         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
     297 
    269298                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    270299      ! 
    271300      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    272301      ! 
     302                               CALL sbc_rnf_init               ! Runof initialisation 
     303      ! 
     304      IF( nn_ice == 3      )   CALL sbc_lim_init               ! LIM3 initialisation 
     305 
    273306      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    274       ! 
    275       IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
    276  
     307       
    277308   END SUBROUTINE sbc_init 
    278309 
     
    314345      !                                            ! ---------------------------------------- ! 
    315346      ! 
    316       IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc 
     347      IF ( .NOT. lk_bdy ) then 
     348         IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc 
     349      ENDIF 
    317350                                                         ! (caution called before sbc_ssm) 
    318351      ! 
    319       CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    320       !                                                  ! averaged over nf_sbc time-step 
     352      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
     353      !                                                        ! averaged over nf_sbc time-step 
    321354 
    322355      IF (ln_wave) CALL sbc_wave( kt ) 
     
    329362      CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    330363      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    331       CASE( jp_core  )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    332       CASE( jp_cpl   )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     364      CASE( jp_core  )    
     365         IF( nn_components == jp_iam_sas ) & 
     366            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA  
     367                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     368                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m) 
     369      CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
     370                                                                        ! 
    333371      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     372      CASE( jp_none  )  
     373         IF( nn_components == jp_iam_opa ) & 
     374                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
    334375      CASE( jp_esopa )                                 
    335376                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
     
    341382      END SELECT 
    342383 
     384      IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
     385 
     386 
    343387      !                                            !==  Misc. Options  ==! 
    344388       
     
    363407      !                                                           ! (update freshwater fluxes) 
    364408!RBbug do not understand why see ticket 667 
    365       !clem-bugsal CALL lbc_lnk( emp, 'T', 1. ) 
     409!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 
     410      CALL lbc_lnk( emp, 'T', 1. ) 
    366411      ! 
    367412      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
     
    404449         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    405450         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
    406          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 
     451         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx ) 
    407452      ENDIF 
    408453 
     
    419464         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    420465         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    421          IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     466         IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
    422467         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
    423468         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r5038 r5620  
    3232 
    3333   PUBLIC   sbc_rnf       ! routine call in sbcmod module 
    34    PUBLIC   sbc_rnf_div   ! routine called in sshwzv module 
     34   PUBLIC   sbc_rnf_div   ! routine called in divcurl module 
    3535   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module 
    3636   PUBLIC   sbc_rnf_init  ! (PUBLIC for TAM) 
    3737   !                                                     !!* namsbc_rnf namelist * 
    38    CHARACTER(len=100), PUBLIC ::   cn_dir          !: Root directory for location of ssr files 
    39    LOGICAL           , PUBLIC ::   ln_rnf_depth    !: depth       river runoffs attribute specified in a file 
    40    LOGICAL           , PUBLIC ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file 
     38   CHARACTER(len=100)         ::   cn_dir          !: Root directory for location of rnf files 
     39   LOGICAL                    ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file 
     40   LOGICAL                    ::   ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation 
     41   REAL(wp)                   ::   rn_rnf_max        !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true ) 
     42   REAL(wp)                   ::   rn_dep_max        !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true ) 
     43   INTEGER                    ::   nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 
     44   LOGICAL                    ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file 
    4145   LOGICAL           , PUBLIC ::   ln_rnf_sal      !: salinity    river runoffs attribute specified in a file 
    42    LOGICAL           , PUBLIC ::   ln_rnf_emp      !: runoffs into a file to be read or already into precipitation 
    4346   TYPE(FLD_N)       , PUBLIC ::   sn_rnf          !: information about the runoff file to be read 
    44    TYPE(FLD_N)       , PUBLIC ::   sn_cnf          !: information about the runoff mouth file to be read 
     47   TYPE(FLD_N)               ::   sn_cnf          !: information about the runoff mouth file to be read 
    4548   TYPE(FLD_N)                ::   sn_s_rnf        !: information about the salinities of runoff file to be read 
    4649   TYPE(FLD_N)                ::   sn_t_rnf        !: information about the temperatures of runoff file to be read 
    4750   TYPE(FLD_N)                ::   sn_dep_rnf      !: information about the depth which river inflow affects 
    4851   LOGICAL           , PUBLIC ::   ln_rnf_mouth    !: specific treatment in mouths vicinity 
    49    REAL(wp)          , PUBLIC ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used 
     52   REAL(wp)                  ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used 
    5053   REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s] 
    51    REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff 
     54   REAL(wp)                   ::   rn_rfact        !: multiplicative factor for runoff 
     55 
     56   LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis 
    5257 
    5358   INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths 
     
    5863   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]    
    5964 
    60    TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) 
    61    TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)   
    62    TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)   
     65   TYPE(FLD),       ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) 
     66   TYPE(FLD),       ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)   
     67   TYPE(FLD),       ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)   
    6368  
    6469   !! * Substitutions   
     
    105110      CALL wrk_alloc( jpi,jpj, ztfrz) 
    106111 
    107       ! 
    108       IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures 
    109  
    110112      !                                            ! ---------------------------------------- ! 
    111113      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
     
    116118      ENDIF 
    117119 
    118       !                                                   !-------------------! 
    119       IF( .NOT. ln_rnf_emp ) THEN                         !   Update runoff   ! 
    120          !                                                !-------------------! 
    121          ! 
    122                              CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
    123          IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required 
    124          IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
    125          ! 
    126          ! Runoff reduction only associated to the ORCA2_LIM configuration 
    127          ! when reading the NetCDF file runoff_1m_nomask.nc 
    128          IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN 
    129             WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 
    130                sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 
     120      !                                            !-------------------! 
     121      !                                            !   Update runoff   ! 
     122      !                                            !-------------------! 
     123      ! 
     124      IF( .NOT. l_rnfcpl )   CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
     125      IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required 
     126      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
     127      ! 
     128      ! Runoff reduction only associated to the ORCA2_LIM configuration 
     129      ! when reading the NetCDF file runoff_1m_nomask.nc 
     130      IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN 
     131         WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 
     132            sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 
     133         END WHERE 
     134      ENDIF 
     135      ! 
     136      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     137         ! 
     138         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
     139         ! 
     140         !                                                     ! set temperature & salinity content of runoffs 
     141         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
     142            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     143            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
     144               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    131145            END WHERE 
    132          ENDIF 
    133          ! 
    134          IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    135             ! 
    136             rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
    137             ! 
    138             !                                                     ! set temperature & salinity content of runoffs 
    139             IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
    140                rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    141                WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
    142                    rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    143                END WHERE 
    144                WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
    145                    ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 
    146                    rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 
    147                END WHERE 
    148             ELSE                                                        ! use SST as runoffs temperature 
    149                rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    150             ENDIF 
    151             !                                                           ! use runoffs salinity data 
    152             IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    153             !                                                           ! else use S=0 for runoffs (done one for all in the init) 
    154             IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1 
    155             IF(lk_mpp) CALL mpp_sum(z_err) 
    156             IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' ) 
    157             ! 
    158             CALL iom_put( "runoffs", rnf )         ! output runoffs arrays 
    159          ENDIF 
    160          ! 
    161       ENDIF 
    162       ! 
     146            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
     147               ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 
     148               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 
     149            END WHERE 
     150         ELSE                                                        ! use SST as runoffs temperature 
     151            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
     152         ENDIF 
     153         !                                                           ! use runoffs salinity data 
     154         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     155         !                                                           ! else use S=0 for runoffs (done one for all in the init) 
     156         CALL iom_put( "runoffs", rnf )         ! output runoffs arrays 
     157      ENDIF 
     158      ! 
     159      !                                                ! ---------------------------------------- ! 
    163160      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    164161         !                                             ! ---------------------------------------- ! 
     
    171168         ELSE                                                   !* no restart: set from nit000 values 
    172169            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    173              rnf_b    (:,:  ) = rnf    (:,:  ) 
    174              rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
     170            rnf_b    (:,:  ) = rnf    (:,:  ) 
     171            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
    175172         ENDIF 
    176173      ENDIF 
     
    186183         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 
    187184      ENDIF 
     185      ! 
    188186      CALL wrk_dealloc( jpi,jpj, ztfrz) 
    189187      ! 
     
    211209      zfact = 0.5_wp 
    212210      ! 
    213       IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==! 
     211      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    214212         IF( lk_vvl ) THEN             ! variable volume case 
    215213            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 
     
    255253      !!---------------------------------------------------------------------- 
    256254      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name 
    257       INTEGER           ::   ji, jj, jk    ! dummy loop indices 
     255      INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices 
    258256      INTEGER           ::   ierror, inum  ! temporary integer 
    259257      INTEGER           ::   ios           ! Local integer output status for namelist read 
    260       ! 
    261       NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
     258      INTEGER           ::   nbrec         ! temporary integer 
     259      REAL(wp)          ::   zacoef   
     260      REAL(wp), DIMENSION(12)                 :: zrec             ! times records 
     261      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl     
     262      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf 
     263      ! 
     264      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
    262265         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
    263          &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact 
    264       !!---------------------------------------------------------------------- 
     266         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     & 
     267         &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file 
     268      !!---------------------------------------------------------------------- 
     269      ! 
     270      !                                         !==  allocate runoff arrays 
     271      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 
     272      ! 
     273      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths  
     274         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl 
     275         nkrnf         = 0 
     276         rnf     (:,:) = 0.0_wp 
     277         rnf_b   (:,:) = 0.0_wp 
     278         rnfmsk  (:,:) = 0.0_wp 
     279         rnfmsk_z(:)   = 0.0_wp 
     280         RETURN 
     281      ENDIF 
    265282      ! 
    266283      !                                   ! ============ 
     
    283300         WRITE(numout,*) '~~~~~~~ ' 
    284301         WRITE(numout,*) '   Namelist namsbc_rnf' 
    285          WRITE(numout,*) '      runoff in a file to be read                ln_rnf_emp   = ', ln_rnf_emp 
    286302         WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth 
    287303         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf 
     
    289305         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact 
    290306      ENDIF 
    291       ! 
    292307      !                                   ! ================== 
    293308      !                                   !   Type of runoff 
    294309      !                                   ! ================== 
    295       !                                         !==  allocate runoff arrays 
    296       IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 
    297       ! 
    298       IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==! 
    299          IF(lwp) WRITE(numout,*) 
    300          IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations' 
    301          IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN 
    302            CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 
    303            ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE. 
    304          ENDIF 
    305          ! 
    306       ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==! 
    307          ! 
     310      ! 
     311      IF( .NOT. l_rnfcpl ) THEN                     
    308312         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow) 
    309313         IF(lwp) WRITE(numout,*) 
     
    314318         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   ) 
    315319         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 
    316          !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print 
    317320         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 
    318          ! 
    319          IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
    320             IF(lwp) WRITE(numout,*) 
    321             IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file' 
    322             ALLOCATE( sf_t_rnf(1), STAT=ierror  ) 
    323             IF( ierror > 0 ) THEN 
    324                CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN 
    325             ENDIF 
    326             ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   ) 
    327             IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 
    328             CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
    329          ENDIF 
    330          ! 
    331          IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures 
    332             IF(lwp) WRITE(numout,*) 
    333             IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file' 
    334             ALLOCATE( sf_s_rnf(1), STAT=ierror  ) 
    335             IF( ierror > 0 ) THEN 
    336                CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN 
    337             ENDIF 
    338             ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   ) 
    339             IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 
    340             CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
    341          ENDIF 
    342          ! 
    343          IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
    344             IF(lwp) WRITE(numout,*) 
    345             IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
    346             rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
    347             IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
    348                IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
    349             ENDIF  
    350             CALL iom_open ( rn_dep_file, inum )                           ! open file 
    351             CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
    352             CALL iom_close( inum )                                        ! close file 
    353             ! 
    354             nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    355             DO jj = 1, jpj 
    356                DO ji = 1, jpi 
    357                   IF( h_rnf(ji,jj) > 0._wp ) THEN 
    358                      jk = 2 
    359                      DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO 
    360                      nk_rnf(ji,jj) = jk 
    361                   ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
    362                   ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
    363                   ELSE 
    364                      CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
    365                      WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 
    366                   ENDIF 
     321      ENDIF 
     322      ! 
     323      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
     324         IF(lwp) WRITE(numout,*) 
     325         IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file' 
     326         ALLOCATE( sf_t_rnf(1), STAT=ierror  ) 
     327         IF( ierror > 0 ) THEN 
     328            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN 
     329         ENDIF 
     330         ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   ) 
     331         IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 
     332         CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
     333      ENDIF 
     334      ! 
     335      IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures 
     336         IF(lwp) WRITE(numout,*) 
     337         IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file' 
     338         ALLOCATE( sf_s_rnf(1), STAT=ierror  ) 
     339         IF( ierror > 0 ) THEN 
     340            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN 
     341         ENDIF 
     342         ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   ) 
     343         IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 
     344         CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
     345      ENDIF 
     346      ! 
     347      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
     348         IF(lwp) WRITE(numout,*) 
     349         IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
     350         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
     351         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
     352            IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
     353         ENDIF 
     354         CALL iom_open ( rn_dep_file, inum )                           ! open file 
     355         CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
     356         CALL iom_close( inum )                                        ! close file 
     357         ! 
     358         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
     359         DO jj = 1, jpj 
     360            DO ji = 1, jpi 
     361               IF( h_rnf(ji,jj) > 0._wp ) THEN 
     362                  jk = 2 
     363                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 
     364                  END DO 
     365                  nk_rnf(ji,jj) = jk 
     366               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
     367               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
     368               ELSE 
     369                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
     370                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 
     371               ENDIF 
     372            END DO 
     373         END DO 
     374         DO jj = 1, jpj                                ! set the associated depth 
     375            DO ji = 1, jpi 
     376               h_rnf(ji,jj) = 0._wp 
     377               DO jk = 1, nk_rnf(ji,jj) 
     378                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
    367379               END DO 
    368380            END DO 
    369             DO jj = 1, jpj                                ! set the associated depth 
    370                DO ji = 1, jpi 
    371                   h_rnf(ji,jj) = 0._wp 
    372                   DO jk = 1, nk_rnf(ji,jj) 
    373                      h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
     381         END DO 
     382         ! 
     383      ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface 
     384         ! 
     385         IF(lwp) WRITE(numout,*) 
     386         IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff' 
     387         IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 
     388         IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max 
     389         IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file 
     390 
     391         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file 
     392         CALL iom_gettime( inum, zrec, kntime=nbrec) 
     393         ALLOCATE( zrnfcl(jpi,jpj,nbrec) )     ;      ALLOCATE( zrnf(jpi,jpj) ) 
     394         DO jm = 1, nbrec 
     395            CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm ) 
     396         END DO 
     397         CALL iom_close( inum ) 
     398         zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 )   !  maximum value in time 
     399         DEALLOCATE( zrnfcl ) 
     400         ! 
     401         h_rnf(:,:) = 1. 
     402         ! 
     403         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff) 
     404         ! 
     405         WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs 
     406         ! 
     407         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin 
     408            DO ji = 1, jpi 
     409               IF( zrnf(ji,jj) > 0._wp ) THEN 
     410                  jk = mbkt(ji,jj) 
     411                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) ) 
     412               ENDIF 
     413            END DO 
     414         END DO 
     415         ! 
     416         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed 
     417         DO jj = 1, jpj 
     418            DO ji = 1, jpi 
     419               IF( zrnf(ji,jj) > 0._wp ) THEN 
     420                  jk = 2 
     421                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 
    374422                  END DO 
     423                  nk_rnf(ji,jj) = jk 
     424               ELSE 
     425                  nk_rnf(ji,jj) = 1 
     426               ENDIF 
     427            END DO 
     428         END DO 
     429         ! 
     430         DEALLOCATE( zrnf ) 
     431         ! 
     432         DO jj = 1, jpj                                ! set the associated depth 
     433            DO ji = 1, jpi 
     434               h_rnf(ji,jj) = 0._wp 
     435               DO jk = 1, nk_rnf(ji,jj) 
     436                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
    375437               END DO 
    376438            END DO 
    377          ELSE                                       ! runoffs applied at the surface 
    378             nk_rnf(:,:) = 1 
    379             h_rnf (:,:) = fse3t(:,:,1) 
    380          ENDIF 
    381          ! 
     439         END DO 
     440         ! 
     441         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff 
     442            IF(lwp) WRITE(numout,*) '              create runoff depht file' 
     443            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     444            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 
     445            CALL iom_close ( inum ) 
     446         ENDIF 
     447      ELSE                                       ! runoffs applied at the surface 
     448         nk_rnf(:,:) = 1 
     449         h_rnf (:,:) = fse3t(:,:,1) 
    382450      ENDIF 
    383451      ! 
     
    400468         IF( rn_hrnf > 0._wp ) THEN 
    401469            nkrnf = 2 
    402             DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO 
     470            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1 
     471            END DO 
    403472            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 
    404473         ENDIF 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r5038 r5620  
    5858      REAL(wp) ::   zcoef, zf_sbc       ! local scalar 
    5959      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 
    60       REAL(wp), DIMENSION(jpi,jpj)      :: zub, zvb,zdep 
    6160      !!--------------------------------------------------------------------- 
    62        
    63       !                                        !* first wet T-, U-, V- ocean level (ISF) variables (T, S, depth, velocity) 
     61 
     62      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 
    6463      DO jj = 1, jpj 
    6564         DO ji = 1, jpi 
    66             zub(ji,jj)        = ub (ji,jj,miku(ji,jj)) 
    67             zvb(ji,jj)        = vb (ji,jj,mikv(ji,jj)) 
    6865            zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem) 
    6966            zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal) 
     
    7168      END DO 
    7269      ! 
    73       IF( lk_vvl ) THEN 
    74          DO jj = 1, jpj 
    75             DO ji = 1, jpi 
    76                zdep(ji,jj) = fse3t_n(ji,jj,mikt(ji,jj)) 
    77             END DO 
    78          END DO 
    79       ENDIF 
    80       !                                                   ! ---------------------------------------- ! 
    8170      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    8271         !                                                ! ---------------------------------------- ! 
    83          ssu_m(:,:) = zub(:,:) 
    84          ssv_m(:,:) = zvb(:,:) 
     72         ssu_m(:,:) = ub(:,:,1) 
     73         ssv_m(:,:) = vb(:,:,1) 
    8574         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    8675         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
     
    9281         ENDIF 
    9382         ! 
    94          IF( lk_vvl )   fse3t_m(:,:) = zdep(:,:) 
     83         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1) 
     84         ! 
     85         frq_m(:,:) = fraqsr_1lev(:,:) 
    9586         ! 
    9687      ELSE 
     
    10192            IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values' 
    10293            zcoef = REAL( nn_fsbc - 1, wp ) 
    103             ssu_m(:,:) = zcoef * zub(:,:) 
    104             ssv_m(:,:) = zcoef * zvb(:,:) 
     94            ssu_m(:,:) = zcoef * ub(:,:,1) 
     95            ssv_m(:,:) = zcoef * vb(:,:,1) 
    10596            IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    10697            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
     
    112103            ENDIF 
    113104            ! 
    114             IF( lk_vvl )   fse3t_m(:,:) = zcoef * zdep(:,:) 
     105            IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_n(:,:,1) 
     106            ! 
     107            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
    115108            !                                             ! ---------------------------------------- ! 
    116109         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
     
    121114            sss_m(:,:) = 0.e0 
    122115            ssh_m(:,:) = 0.e0 
    123             IF( lk_vvl )   fse3t_m(:,:) = 0.e0 
     116            IF( lk_vvl )   e3t_m(:,:) = 0.e0 
     117            frq_m(:,:) = 0.e0 
    124118         ENDIF 
    125119         !                                                ! ---------------------------------------- ! 
    126120         !                                                !        Cumulate at each time step        ! 
    127121         !                                                ! ---------------------------------------- ! 
    128          ssu_m(:,:) = ssu_m(:,:) + zub(:,:) 
    129          ssv_m(:,:) = ssv_m(:,:) + zvb(:,:) 
     122         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
     123         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    130124         IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    131125         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
     
    137131         ENDIF 
    138132         ! 
    139          IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:) 
     133         IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 
     134         ! 
     135         frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:) 
    140136 
    141137         !                                                ! ---------------------------------------- ! 
     
    148144            ssv_m(:,:) = ssv_m(:,:) * zcoef           ! 
    149145            ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m] 
    150             IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
     146            IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
     147            frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
    151148            ! 
    152149         ENDIF 
     
    165162            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  ) 
    166163            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  ) 
    167             IF( lk_vvl ) THEN 
    168                CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m'  , fse3t_m(:,:)  ) 
    169             END IF 
    170             ! 
    171          ENDIF 
    172          ! 
     164            IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  ) 
     165            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  ) 
     166            ! 
     167         ENDIF 
     168         ! 
     169      ENDIF 
     170      ! 
     171      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   ! 
     172         CALL iom_put( 'ssu_m', ssu_m ) 
     173         CALL iom_put( 'ssv_m', ssv_m ) 
     174         CALL iom_put( 'sst_m', sst_m ) 
     175         CALL iom_put( 'sss_m', sss_m ) 
     176         CALL iom_put( 'ssh_m', ssh_m ) 
     177         IF( lk_vvl )   CALL iom_put( 'e3t_m', e3t_m ) 
     178         CALL iom_put( 'frq_m', frq_m ) 
    173179      ENDIF 
    174180      ! 
     
    206212            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point) 
    207213            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point) 
    208             IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) ) 
     214            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m ) 
     215            ! fraction of solar net radiation absorbed in 1st T level 
     216            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 
     217               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  ) 
     218            ELSE 
     219               frq_m(:,:) = 1._wp   ! default definition 
     220            ENDIF 
    209221            ! 
    210222            IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs 
     
    217229               sss_m(:,:) = zcoef * sss_m(:,:) 
    218230               ssh_m(:,:) = zcoef * ssh_m(:,:) 
    219                IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:) 
     231               IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_m(:,:) 
     232               frq_m(:,:) = zcoef * frq_m(:,:) 
    220233            ELSE 
    221234               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file' 
     
    224237      ENDIF 
    225238      ! 
     239      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate 
     240         ! 
     241         IF(lwp) WRITE(numout,*) '          default initialisation of ss?_m arrays' 
     242         ssu_m(:,:) = ub(:,:,1) 
     243         ssv_m(:,:) = vb(:,:,1) 
     244         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     245         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
     246         ENDIF 
     247         sss_m(:,:) = tsn(:,:,1,jp_sal) 
     248         ssh_m(:,:) = sshn(:,:) 
     249         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1) 
     250         frq_m(:,:) = 1._wp 
     251         ! 
     252      ENDIF 
     253      ! 
    226254   END SUBROUTINE sbc_ssm_init 
    227255 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90

    • Property svn:keywords set to Id
    r4292 r5620  
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
    38    !! $Id: $ 
     38   !! $Id$ 
    3939   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    • Property svn:keywords set to Id
    r4792 r5620  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OPA 4.0 , NEMO Consortium (2011)  
    41    !! $Id: $ 
     41   !! $Id$ 
    4242   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90

    • Property svn:keywords set to Id
    r4292 r5620  
    3535   !!---------------------------------------------------------------------- 
    3636   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    37    !! $Id:$  
     37   !! $Id$  
    3838   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

    • Property svn:keywords set to Id
    r4792 r5620  
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
    38    !! $Id: $ 
     38   !! $Id$ 
    3939   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 
     
    8080          END DO 
    8181       END DO 
     82       !        
     83       ! Ensure that tidal components have been set in namelist_cfg 
     84       IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 
    8285       ! 
    8386       IF(lwp) THEN 
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90

    • Property svn:keywords set to Id
    r4292 r5620  
    2626   !!---------------------------------------------------------------------- 
    2727   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    28    !! $Id: sbcfwb.F90 3625 2012-11-21 13:19:18Z acc $ 
     28   !! $Id$ 
    2929   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3030   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.