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 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
20 edited
7 copied

Legend:

Unmodified
Added
Removed

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

    r2715 r3294  
    1919   USE in_out_manager  ! I/O manager 
    2020   USE lib_mpp         ! MPP library 
     21   USE wrk_nemo        ! work arrays 
    2122 
    2223   IMPLICIT NONE 
    … …  
    6566      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
    6667      !!---------------------------------------------------------------------- 
    67       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    68       USE wrk_nemo, ONLY:   wrk_3d_6 , wrk_3d_7    ! 3D workspace 
    69       !! 
    7068      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin) 
    7169      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice      !  sea-ice thickness 
    … …  
    9189      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
    9290 
    93       IF( wrk_in_use(3, 6,7) ) THEN 
    94          CALL ctl_stop('albedo_ice: requested workspace arrays are unavailable')   ;   RETURN 
    95       ENDIF 
    96       ! Associate pointers with sub-arrays of workspace arrays 
    97       zalbfz  =>   wrk_3d_6(:,:,1:ijpl) 
    98       zficeth =>   wrk_3d_7(:,:,1:ijpl) 
     91      CALL wrk_alloc( jpi,jpj,ijpl, zalbfz, zficeth ) 
    9992 
    10093      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    … …  
    173166      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction 
    174167      ! 
    175       IF( wrk_not_released(3, 6,7) )   CALL ctl_stop('albedo_ice: failed to release workspace arrays') 
     168      CALL wrk_dealloc( jpi,jpj,ijpl, zalbfz, zficeth ) 
    176169      ! 
    177170   END SUBROUTINE albedo_ice 

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

    r2715 r3294  
    1313   !!   " "  !  06-01  (W. Park) modification of physical part 
    1414   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange 
     15   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields 
    1516   !!---------------------------------------------------------------------- 
    1617#if defined key_oasis3 
    … …  
    5253   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields 
    5354    
    54    TYPE, PUBLIC ::   FLD_CPL            !: Type for coupling field information 
    55       LOGICAL            ::   laction   ! To be coupled or not 
    56       CHARACTER(len = 8) ::   clname    ! Name of the coupling field    
    57       CHARACTER(len = 1) ::   clgrid    ! Grid type   
    58       REAL(wp)           ::   nsgn      ! Control of the sign change 
    59       INTEGER            ::   nid       ! Id of the field 
     55   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
     56      LOGICAL               ::   laction   ! To be coupled or not 
     57      CHARACTER(len = 8)    ::   clname    ! Name of the coupling field    
     58      CHARACTER(len = 1)    ::   clgrid    ! Grid type   
     59      REAL(wp)              ::   nsgn      ! Control of the sign change 
     60      INTEGER, DIMENSION(9) ::   nid       ! Id of the field (no more than 9 categories) 
     61      INTEGER               ::   nct       ! Number of categories in field 
    6062   END TYPE FLD_CPL 
    6163 
    … …  
    118120      INTEGER :: paral(5)       ! OASIS3 box partition 
    119121      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe 
    120       INTEGER :: ji             ! local loop indicees 
     122      INTEGER :: ji,jc          ! local loop indicees 
     123      CHARACTER(LEN=8) :: zclname 
    121124      !!-------------------------------------------------------------------- 
    122125 
    … …  
    164167      DO ji = 1, ksnd 
    165168         IF ( ssnd(ji)%laction ) THEN  
    166             CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/),  & 
    167                &                      PRISM_Out   , ishape   , PRISM_REAL, nerror) 
    168             IF ( nerror /= PRISM_Ok ) THEN 
    169                WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname) 
    170                CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 
    171             ENDIF 
     169            DO jc = 1, ssnd(ji)%nct 
     170               IF ( ssnd(ji)%nct .gt. 1 ) THEN 
     171                  WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 
     172               ELSE 
     173                  zclname=ssnd(ji)%clname 
     174               ENDIF 
     175               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 
     176               CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
     177                    PRISM_Out, ishape, PRISM_REAL, nerror) 
     178               IF ( nerror /= PRISM_Ok ) THEN 
     179                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
     180                  CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
     181               ENDIF 
     182            END DO 
    172183         ENDIF 
    173184      END DO 
    … …  
    177188      DO ji = 1, krcv 
    178189         IF ( srcv(ji)%laction ) THEN  
    179             CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/),   & 
    180                &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
    181             IF ( nerror /= PRISM_Ok ) THEN 
    182                WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname) 
    183                CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 
    184             ENDIF 
     190            DO jc = 1, srcv(ji)%nct 
     191               IF ( srcv(ji)%nct .gt. 1 ) THEN 
     192                  WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 
     193               ELSE 
     194                  zclname=srcv(ji)%clname 
     195               ENDIF 
     196               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 
     197               CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
     198                    &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
     199               IF ( nerror /= PRISM_Ok ) THEN 
     200                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 
     201                  CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 
     202               ENDIF 
     203            END DO 
    185204         ENDIF 
    186205      END DO 
    … …  
    203222      !!      like sst or ice cover to the coupler or remote application. 
    204223      !!---------------------------------------------------------------------- 
    205       INTEGER                 , INTENT(in   ) ::   kid       ! variable index in the array 
    206       INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    207       INTEGER                 , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
    208       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pdata 
     224      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array 
     225      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
     226      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
     227      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata 
     228      !! 
     229      INTEGER                                   ::   jc        ! local loop index 
    209230      !!-------------------------------------------------------------------- 
    210231      ! 
    211232      ! snd data to OASIS3 
    212233      ! 
    213       CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo ) 
    214        
    215       IF ( ln_ctl ) THEN         
    216          IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   & 
    217             & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
    218             WRITE(numout,*) '****************' 
    219             WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 
    220             WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid 
    221             WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
    222             WRITE(numout,*) 'prism_put_proto:   info ', kinfo 
    223             WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata) 
    224             WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata) 
    225             WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    226             WRITE(numout,*) '****************' 
     234      DO jc = 1, ssnd(kid)%nct 
     235 
     236         CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     237          
     238         IF ( ln_ctl ) THEN         
     239            IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   & 
     240                 & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
     241               WRITE(numout,*) '****************' 
     242               WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 
     243               WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 
     244               WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
     245               WRITE(numout,*) 'prism_put_proto:   info ', kinfo 
     246               WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     247               WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     248               WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     249               WRITE(numout,*) '****************' 
     250            ENDIF 
    227251         ENDIF 
    228       ENDIF 
     252 
     253      ENDDO 
    229254      ! 
    230255    END SUBROUTINE cpl_prism_snd 
    … …  
    238263      !!      like stresses and fluxes from the coupler or remote application. 
    239264      !!---------------------------------------------------------------------- 
    240       INTEGER                 , INTENT(in   ) ::   kid       ! variable index in the array 
    241       INTEGER                 , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
    242       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done 
    243       INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    244       !! 
    245       LOGICAL ::   llaction 
     265      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array 
     266      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds 
     267      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done 
     268      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
     269      !! 
     270      INTEGER                                   ::   jc        ! local loop index 
     271      LOGICAL                                   ::   llaction 
    246272      !!-------------------------------------------------------------------- 
    247273      ! 
    248274      ! receive local data from OASIS3 on every process 
    249275      ! 
    250       CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo )          
    251  
    252       llaction = .false. 
    253       IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
    254           kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
    255  
    256       IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid 
    257  
    258       IF ( llaction ) THEN 
    259  
    260          kinfo = OASIS_Rcv 
    261          pdata(nldi:nlei, nldj:nlej) = exfld(:,:) 
    262           
    263          !--- Fill the overlap areas and extra hallows (mpp) 
    264          !--- check periodicity conditions (all cases) 
    265          CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )    
    266           
    267          IF ( ln_ctl ) THEN         
    268             WRITE(numout,*) '****************' 
    269             WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
    270             WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid 
    271             WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
    272             WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
    273             WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata) 
    274             WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata) 
    275             WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    276             WRITE(numout,*) '****************' 
     276      DO jc = 1, srcv(kid)%nct 
     277 
     278         CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )          
     279          
     280         llaction = .false. 
     281         IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
     282              kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
     283          
     284         IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 
     285          
     286         IF ( llaction ) THEN 
     287             
     288            kinfo = OASIS_Rcv 
     289            pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 
     290             
     291            !--- Fill the overlap areas and extra hallows (mpp) 
     292            !--- check periodicity conditions (all cases) 
     293            CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
     294             
     295            IF ( ln_ctl ) THEN         
     296               WRITE(numout,*) '****************' 
     297               WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
     298               WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc) 
     299               WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
     300               WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
     301               WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc)) 
     302               WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc)) 
     303               WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc)) 
     304               WRITE(numout,*) '****************' 
     305            ENDIF 
     306             
     307         ELSE 
     308            kinfo = OASIS_idle      
    277309         ENDIF 
    278        
    279       ELSE 
    280          kinfo = OASIS_idle      
    281       ENDIF 
     310          
     311      ENDDO 
    282312      ! 
    283313   END SUBROUTINE cpl_prism_rcv 

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

    r2715 r3294  
    3232   USE lbclnk           ! ocean lateral boundary conditions (or mpp link) 
    3333   USE lib_mpp          ! MPP library 
     34   USE wrk_nemo         ! work arrays 
    3435 
    3536   IMPLICIT NONE 
    … …  
    111112      !! ** Method  :   OASIS4 MPI communication  
    112113      !!-------------------------------------------------------------------- 
    113       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    114       USE wrk_nemo, ONLY: zclo => wrk_3d_1, zcla => wrk_3d_2 
    115       USE wrk_nemo, ONLY: zlon => wrk_2d_1, zlat => wrk_2d_2 
    116       ! 
    117114      INTEGER, INTENT(in) :: krcv, ksnd     ! Number of received and sent coupling fields 
    118115      ! 
    … …  
    145142      TYPE(PRISM_Time_struct)    :: tmpdate 
    146143      INTEGER                    :: idate_incr      ! date increment 
    147       !!-------------------------------------------------------------------- 
    148  
    149       IF( wrk_in_use(3, 1,2) .OR. wrk_in_use(2, 1,2) )THEN 
    150          CALL ctl_stop('cpl_prism_define: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    151       ENDIF 
     144      REAL(wp), POINTER, DIMENSION(:,:)   ::   zlon, zlat 
     145      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zclo, zcla 
     146      !!-------------------------------------------------------------------- 
     147       
     148      CALL wrk_alloc( jpi,jpj, zlon, zlat ) 
     149      CALL wrk_alloc( jpi,jpj,jpk, zclo, zcla ) 
    152150 
    153151      IF(lwp) WRITE(numout,*) 
    … …  
    322320      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    323321       
    324       IF( wrk_not_released(3, 1,2) .OR.   & 
    325           wrk_not_released(2, 1,2)   )   CALL ctl_stop('cpl_prism_define: failed to release workspace arrays') 
     322      CALL wrk_dealloc( jpi,jpj, zlon, zlat ) 
     323      CALL wrk_dealloc( jpi,jpj,jpk, zclo, zcla ) 
    326324      ! 
    327325   END SUBROUTINE cpl_prism_define 

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

    r2777 r3294  
    2020   USE geo2ocean       ! for vector rotation on to model grid 
    2121   USE lib_mpp         ! MPP library 
     22   USE wrk_nemo        ! work arrays 
    2223   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar 
    2324 
    2425   IMPLICIT NONE 
    2526   PRIVATE    
     27  
     28   PUBLIC   fld_map    ! routine called by tides_init 
    2629 
    2730   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations 
    … …  
    5659      LOGICAL                         ::   rotn         ! flag to indicate whether field has been rotated 
    5760   END TYPE FLD 
     61 
     62   TYPE, PUBLIC ::   MAP_POINTER      !: Array of integer pointers to 1D arrays 
     63      INTEGER, POINTER   ::  ptr(:) 
     64   END TYPE MAP_POINTER 
    5865 
    5966!$AGRIF_DO_NOT_TREAT 
    … …  
    98105CONTAINS 
    99106 
    100    SUBROUTINE fld_read( kt, kn_fsbc, sd ) 
     107   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset ) 
    101108      !!--------------------------------------------------------------------- 
    102109      !!                    ***  ROUTINE fld_read  *** 
    … …  
    113120      INTEGER  , INTENT(in   )               ::   kn_fsbc   ! sbc computation period (in time step)  
    114121      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
     122      TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) ::   map   ! global-to-local mapping index 
     123      INTEGER  , INTENT(in   ), OPTIONAL     ::   jit       ! subcycle timestep for timesplitting option 
     124      INTEGER  , INTENT(in   ), OPTIONAL     ::   time_offset ! provide fields at time other than "now" 
     125                                                              ! time_offset = -1 => fields at "before" time level 
     126                                                              ! time_offset = +1 => fields at "after" time levels 
     127                                                              ! etc. 
    115128      !! 
    116129      INTEGER  ::   imf        ! size of the structure sd 
    … …  
    119132      INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend 
    120133      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
     134      INTEGER  ::   itime_add  ! local time offset variable 
    121135      LOGICAL  ::   llnxtyr    ! open next year  file? 
    122136      LOGICAL  ::   llnxtmth   ! open next month file? 
    123137      LOGICAL  ::   llstop     ! stop is the file does not exist 
     138      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields 
    124139      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
    125140      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    126141      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    127142      !!--------------------------------------------------------------------- 
     143      ll_firstcall = .false. 
     144      IF( PRESENT(jit) ) THEN 
     145         IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 
     146      ELSE 
     147         IF(kt == nit000) ll_firstcall = .true. 
     148      ENDIF 
     149 
     150      itime_add = 0 
     151      IF( PRESENT(time_offset) ) itime_add = time_offset 
     152          
    128153      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    129       isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1))   ! middle of sbc time step 
     154      IF( present(jit) ) THEN  
     155         ! ignore kn_fsbc in this case 
     156         isecsbc = nsec_year + nsec1jan000 + (jit+itime_add)*rdt/REAL(nn_baro,wp)  
     157      ELSE 
     158         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + itime_add * rdttra(1)  ! middle of sbc time step 
     159      ENDIF 
    130160      imf = SIZE( sd ) 
    131161      ! 
    132       IF( kt == nit000 ) THEN                      ! initialization 
    133          DO jf = 1, imf  
    134             CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
    135          END DO 
     162      IF( ll_firstcall ) THEN                      ! initialization 
     163         IF( PRESENT(map) ) THEN 
     164            DO jf = 1, imf  
     165               CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr )  ! read each before field (put them in after as they will be swapped) 
     166            END DO 
     167         ELSE 
     168            DO jf = 1, imf  
     169               CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped) 
     170            END DO 
     171         ENDIF 
    136172         IF( lwp ) CALL wgt_print()                ! control print 
    137173         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed 
    … …  
    143179         DO jf = 1, imf                            ! ---   loop over field   --- ! 
    144180             
    145             IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000 ) THEN  ! read/update the after data? 
     181            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN  ! read/update the after data? 
    146182 
    147183               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations 
    … …  
    151187               ENDIF 
    152188 
    153                CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations 
     189               IF( PRESENT(jit) ) THEN 
     190                  CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add, jit=jit )              ! update record informations 
     191               ELSE 
     192                  CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add )                       ! update record informations 
     193               ENDIF 
    154194 
    155195               ! do we have to change the year/month/week/day of the forcing field??  
    … …  
    212252 
    213253               ! read after data 
    214                CALL fld_get( sd(jf) ) 
     254               IF( PRESENT(map) ) THEN 
     255                  CALL fld_get( sd(jf), map(jf)%ptr ) 
     256               ELSE 
     257                  CALL fld_get( sd(jf) ) 
     258               ENDIF 
    215259 
    216260            ENDIF 
    … …  
    225269                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    226270                     &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 
    227                   WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   & 
     271                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &             
    228272                     & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
     273                  WRITE(numout, *) 'itime_add is : ',itime_add 
    229274               ENDIF 
    230275               ! temporal interpolation weights 
    … …  
    253298 
    254299 
    255    SUBROUTINE fld_init( kn_fsbc, sdjf ) 
     300   SUBROUTINE fld_init( kn_fsbc, sdjf, map ) 
    256301      !!--------------------------------------------------------------------- 
    257302      !!                    ***  ROUTINE fld_init  *** 
    … …  
    262307      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step)  
    263308      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables 
     309      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 
    264310      !! 
    265311      LOGICAL :: llprevyr              ! are we reading previous year  file? 
    … …  
    364410 
    365411         ! read before data  
    366          CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later) 
     412         IF( PRESENT(map) ) THEN 
     413            CALL fld_get( sdjf, map )  ! read before values in after arrays(as we will swap it later) 
     414         ELSE 
     415            CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later) 
     416         ENDIF 
    367417 
    368418         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 
    … …  
    396446 
    397447 
    398    SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore ) 
     448   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit, time_offset ) 
    399449      !!--------------------------------------------------------------------- 
    400450      !!                    ***  ROUTINE fld_rec  *** 
    … …  
    410460      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables 
    411461      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.) 
     462      INTEGER  , INTENT(in   ), OPTIONAL ::   jit       ! index of barotropic subcycle 
    412463                                                        ! used only if sdjf%ln_tint = .TRUE. 
     464      INTEGER  , INTENT(in   ), OPTIONAL ::   time_offset  ! Offset of required time level compared to "now" 
     465                                                           ! time level in units of time steps. 
    413466      !! 
    414467      LOGICAL  ::   llbefore    ! local definition of ldbefore 
    … …  
    417470      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds) 
    418471      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file 
     472      INTEGER  ::   itime_add   ! local time offset variable 
    419473      REAL(wp) ::   ztmp        ! temporary variable 
    420474      !!---------------------------------------------------------------------- 
    … …  
    425479      ELSE                           ;   llbefore = .FALSE. 
    426480      ENDIF 
     481      ! 
     482      itime_add = 0 
     483      IF( PRESENT(time_offset) ) itime_add = time_offset 
    427484      ! 
    428485      !                                      ! =========== ! 
    … …  
    443500            !                             
    444501            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 
     502            IF( PRESENT(jit) ) THEN  
     503               ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 
     504            ELSE 
     505               ztmp = ztmp + itime_add*rdttra(1) 
     506            ENDIF 
    445507            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    446508            ! swap at the middle of the year 
    … …  
    471533            !                             
    472534            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     535            IF( PRESENT(jit) ) THEN  
     536               ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 
     537            ELSE 
     538               ztmp = ztmp + itime_add*rdttra(1) 
     539            ENDIF 
    473540            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    474541            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    … …  
    498565         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step 
    499566         ztmp = ztmp + 0.01 * rdttra(1)                          ! add 0.01 time step to avoid truncation error  
     567         IF( PRESENT(jit) ) THEN  
     568            ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 
     569         ELSE 
     570            ztmp = ztmp + itime_add*rdttra(1) 
     571         ENDIF 
    500572         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    501573            ! 
    … …  
    546618 
    547619 
    548    SUBROUTINE fld_get( sdjf ) 
    549       !!--------------------------------------------------------------------- 
    550       !!                    ***  ROUTINE fld_clopn  *** 
     620   SUBROUTINE fld_get( sdjf, map ) 
     621      !!--------------------------------------------------------------------- 
     622      !!                    ***  ROUTINE fld_get  *** 
    551623      !! 
    552624      !! ** Purpose :   read the data 
    553625      !!---------------------------------------------------------------------- 
    554626      TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables 
     627      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 
    555628      !! 
    556629      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    … …  
    559632             
    560633      ipk = SIZE( sdjf%fnow, 3 ) 
    561       IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
     634 
     635      IF( PRESENT(map) ) THEN 
     636         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 
     637         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map ) 
     638         ENDIF 
     639      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    562640         CALL wgt_list( sdjf, iw ) 
    563641         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    … …  
    581659   END SUBROUTINE fld_get 
    582660 
     661   SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 
     662      !!--------------------------------------------------------------------- 
     663      !!                    ***  ROUTINE fld_get  *** 
     664      !! 
     665      !! ** Purpose :   read global data from file and map onto local data 
     666      !!                using a general mapping (for open boundaries) 
     667      !!---------------------------------------------------------------------- 
     668#if defined key_bdy 
     669      USE bdy_oce, ONLY:  dta_global         ! workspace to read in global data arrays 
     670#endif  
     671 
     672      INTEGER                   , INTENT(in ) ::   num     ! stream number 
     673      CHARACTER(LEN=*)          , INTENT(in ) ::   clvar   ! variable name 
     674      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta   ! output field on model grid (2 dimensional) 
     675      INTEGER                   , INTENT(in ) ::   nrec    ! record number to read (ie time slice) 
     676      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices 
     677      !! 
     678      INTEGER                                 ::   ipi      ! length of boundary data on local process 
     679      INTEGER                                 ::   ipj      ! length of dummy dimension ( = 1 ) 
     680      INTEGER                                 ::   ipk      ! number of vertical levels of dta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     681      INTEGER                                 ::   ilendta  ! length of data in file 
     682      INTEGER                                 ::   idvar    ! variable ID 
     683      INTEGER                                 ::   ib, ik   ! loop counters 
     684      INTEGER                                 ::   ierr 
     685      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read ! work space for global data 
     686      !!--------------------------------------------------------------------- 
     687             
     688#if defined key_bdy 
     689      dta_read => dta_global 
     690#endif 
     691 
     692      ipi = SIZE( dta, 1 ) 
     693      ipj = 1 
     694      ipk = SIZE( dta, 3 ) 
     695 
     696      idvar   = iom_varid( num, clvar ) 
     697      ilendta = iom_file(num)%dimsz(1,idvar) 
     698      IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 
     699      IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 
     700 
     701      SELECT CASE( ipk ) 
     702      CASE(1)    
     703         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1    ), nrec ) 
     704      CASE DEFAULT 
     705         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 
     706      END SELECT 
     707      ! 
     708      DO ib = 1, ipi 
     709         DO ik = 1, ipk 
     710            dta(ib,1,ik) =  dta_read(map(ib),1,ik) 
     711         END DO 
     712      END DO 
     713 
     714   END SUBROUTINE fld_map 
     715 
    583716 
    584717   SUBROUTINE fld_rot( kt, sd ) 
    585718      !!--------------------------------------------------------------------- 
    586       !!                    ***  ROUTINE fld_clopn  *** 
     719      !!                    ***  ROUTINE fld_rot  *** 
    587720      !! 
    588721      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction 
    589722      !!---------------------------------------------------------------------- 
    590       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    591       USE wrk_nemo, ONLY: utmp => wrk_2d_4, vtmp => wrk_2d_5      ! 2D workspace 
    592       !! 
    593723      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
    594724      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    595725      !! 
    596       INTEGER                      ::   ju, jv, jk   ! loop indices 
    597       INTEGER                      ::   imf          ! size of the structure sd 
    598       INTEGER                      ::   ill          ! character length 
    599       INTEGER                      ::   iv           ! indice of V component 
    600       CHARACTER (LEN=100)          ::   clcomp       ! dummy weight name 
    601       !!--------------------------------------------------------------------- 
    602  
    603       IF(wrk_in_use(2, 4,5) ) THEN 
    604          CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    605       END IF 
     726      INTEGER                           ::   ju, jv, jk   ! loop indices 
     727      INTEGER                           ::   imf          ! size of the structure sd 
     728      INTEGER                           ::   ill          ! character length 
     729      INTEGER                           ::   iv           ! indice of V component 
     730      REAL(wp), POINTER, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation 
     731      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name 
     732      !!--------------------------------------------------------------------- 
     733 
     734      CALL wrk_alloc( jpi,jpj, utmp, vtmp ) 
    606735 
    607736      !! (sga: following code should be modified so that pairs arent searched for each time 
    … …  
    638767       END DO 
    639768      ! 
    640       IF(wrk_not_released(2, 4,5) )    CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 
     769      CALL wrk_dealloc( jpi,jpj, utmp, vtmp ) 
    641770      ! 
    642771   END SUBROUTINE fld_rot 
    … …  
    672801      ! 
    673802      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    674       ! 
     803     ! 
    675804   END SUBROUTINE fld_clopn 
    676805 
    … …  
    805934      !!                file, restructuring as required 
    806935      !!---------------------------------------------------------------------- 
    807       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    808       USE wrk_nemo, ONLY:   data_tmp =>  wrk_2d_1     ! 2D real    workspace 
    809       USE wrk_nemo, ONLY:   data_src => iwrk_2d_1     ! 2D integer workspace 
    810       !! 
    811936      TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file 
    812937      !! 
    813       INTEGER                ::   jn            ! dummy loop indices 
    814       INTEGER                ::   inum          ! temporary logical unit 
    815       INTEGER                ::   id            ! temporary variable id 
    816       INTEGER                ::   ipk           ! temporary vertical dimension 
    817       CHARACTER (len=5)      ::   aname 
    818       INTEGER , DIMENSION(3) ::   ddims 
    819       LOGICAL                ::   cyclical 
    820       INTEGER                ::   zwrap      ! local integer 
    821       !!---------------------------------------------------------------------- 
    822       ! 
    823       IF(  wrk_in_use(2, 1)  .OR.  iwrk_in_use(2,1) ) THEN 
    824          CALL ctl_stop('fld_weight: requested workspace arrays are unavailable')   ;   RETURN 
    825       ENDIF 
     938      INTEGER                           ::   jn            ! dummy loop indices 
     939      INTEGER                           ::   inum          ! temporary logical unit 
     940      INTEGER                           ::   id            ! temporary variable id 
     941      INTEGER                           ::   ipk           ! temporary vertical dimension 
     942      CHARACTER (len=5)                 ::   aname 
     943      INTEGER , DIMENSION(3)            ::   ddims 
     944      INTEGER , POINTER, DIMENSION(:,:) ::   data_src 
     945      REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp 
     946      LOGICAL                           ::   cyclical 
     947      INTEGER                           ::   zwrap      ! local integer 
     948      !!---------------------------------------------------------------------- 
     949      ! 
     950      CALL wrk_alloc( jpi,jpj, data_src )   ! integer 
     951      CALL wrk_alloc( jpi,jpj, data_tmp ) 
    826952      ! 
    827953      IF( nxt_wgt > tot_wgts ) THEN 
    … …  
    9351061      ENDIF 
    9361062 
    937       IF(  wrk_not_released(2, 1) .OR.    & 
    938           iwrk_not_released(2, 1)  )   CALL ctl_stop('fld_weight: failed to release workspace arrays') 
     1063      CALL wrk_dealloc( jpi,jpj, data_src )   ! integer 
     1064      CALL wrk_dealloc( jpi,jpj, data_tmp ) 
    9391065      ! 
    9401066   END SUBROUTINE fld_weight 

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

    r2777 r3294  
    66   !! History :  3.0  ! 2006-08  (G. Madec)  Surface module 
    77   !!            3.2  ! 2009-06  (S. Masson) merge with ice_oce 
    8    !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     8   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     9   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    910   !!---------------------------------------------------------------------- 
    10 #if defined key_lim3 || defined key_lim2 
     11#if defined key_lim3 || defined key_lim2 || defined key_cice 
    1112   !!---------------------------------------------------------------------- 
    1213   !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model 
    … …  
    1920   USE par_ice_2        ! LIM-2 parameters 
    2021# endif 
     22# if defined key_cice  
     23   USE ice_domain_size, only: ncat  
     24#endif 
    2125   USE lib_mpp          ! MPP library 
    2226   USE in_out_manager   ! I/O manager 
    … …  
    3034   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model 
    3135   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
     36   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
    3237#  if defined key_lim2_vp 
    3338   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'I'      !: VP : 'I'-grid ice-velocity (B-grid lower left corner) 
    … …  
    3944   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
    4045   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .TRUE.   !: LIM-3 ice model 
     46   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
    4147   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: 'C'-grid ice-velocity 
    4248# endif 
     49# if defined  key_cice 
     50   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
     51   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
     52   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .TRUE.   !: CICE ice model 
     53   CHARACTER(len=1), PUBLIC            ::   cp_ice_msh = 'F'      !: 'F'-grid ice-velocity 
     54# endif 
    4355 
     56#if defined key_lim3 || defined key_lim2  
    4457   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice   !: non solar heat flux over ice                  [W/m2] 
    4558   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice   !: solar heat flux over ice                      [W/m2] 
    … …  
    6073# endif 
    6174 
     75#elif defined key_cice 
     76   ! 
     77   ! for consistency with LIM, these are declared with three dimensions 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qlw_ice            !: incoming long-wave 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice            !: latent flux over ice           [W/m2] 
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice            !: solar heat flux over ice       [W/m2] 
     81   ! 
     82   ! other forcing arrays are two dimensional 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iou             !: x ice-ocean surface stress at NEMO U point 
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ss_iov             !: y ice-ocean surface stress at NEMO V point 
     85   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice            !: sublimation-snow budget over ice    [kg/m2] 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice           !: air temperature 
     87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qatm_ice           !: specific humidity 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndi_ice           !: i wind at T point 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndj_ice           !: j wind at T point 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfrzmlt            !: NEMO frzmlt 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point 
     93   ! 
     94   ! finally, arrays corresponding to different ice categories 
     95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i                !: category ice fraction 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt           !: category topmelt 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt           !: category botmelt 
     98#endif 
     99 
    62100   !!---------------------------------------------------------------------- 
    63101   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    … …  
    71109      !!                     ***  FUNCTION sbc_ice_alloc  *** 
    72110      !!---------------------------------------------------------------------- 
     111#if defined key_lim3 || defined key_lim2 
    73112      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
    74113         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
    … …  
    77116         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
    78117         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    79 # if defined key_lim3 
     118#if defined key_lim3 
    80119         &      emp_ice(jpi,jpj)      , tatm_ice(jpi,jpj)     , STAT= sbc_ice_alloc ) 
    81 # else 
     120#else 
    82121         &      emp_ice(jpi,jpj)                              , STAT= sbc_ice_alloc ) 
    83 # endif 
     122#endif 
     123#elif defined key_cice 
     124      ALLOCATE( qla_ice(jpi,jpj,1)    , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , & 
     125                wndi_ice(jpi,jpj)     , tatm_ice(jpi,jpj)     , qatm_ice(jpi,jpj)     , & 
     126                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , & 
     127                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
     128                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= sbc_ice_alloc ) 
     129#endif 
    84130         ! 
    85131      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 
    … …  
    89135#else 
    90136   !!---------------------------------------------------------------------- 
    91    !!   Default option                      NO LIM 2.0 or 3.0 sea-ice model 
     137   !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model 
    92138   !!---------------------------------------------------------------------- 
    93139   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
    94140   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
     141   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
    95142   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity 
    96143#endif 

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

    r2715 r3294  
    3333   LOGICAL , PUBLIC ::   ln_blk_clio = .FALSE.   !: CLIO bulk formulation 
    3434   LOGICAL , PUBLIC ::   ln_blk_core = .FALSE.   !: CORE bulk formulation 
     35   LOGICAL , PUBLIC ::   ln_blk_mfs  = .FALSE.   !: MFS  bulk formulation 
    3536   LOGICAL , PUBLIC ::   ln_cpl      = .FALSE.   !: coupled   formulation (overwritten by key_sbc_coupled ) 
    3637   LOGICAL , PUBLIC ::   ln_dm2dc    = .FALSE.   !: Daily mean to Diurnal Cycle short wave (qsr) 
    … …  
    4344   !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step 
    4445   !                                             !:  = 2 annual global mean of e-p-r set to zero 
     46   LOGICAL , PUBLIC ::   ln_cdgw     = .FALSE.   !: true if neutral drag coefficient read from wave model 
    4547 
    4648   !!---------------------------------------------------------------------- 

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

    r2715 r3294  
    8989         nn_tau000 = MAX( nn_tau000, 1 )     ! must be >= 1 
    9090         ! 
     91         qns (:,:) = rn_qns0 
     92         qsr (:,:) = rn_qsr0 
     93         emp (:,:) = rn_emp0 
     94         emps(:,:) = rn_emp0 
     95         ! 
     96         utau(:,:) = rn_utau0 
     97         vtau(:,:) = rn_vtau0 
     98         taum(:,:) = SQRT ( rn_utau0 * rn_utau0 + rn_vtau0 * rn_vtau0 ) 
     99         wndm(:,:) = SQRT ( taum(1,1) /  ( zrhoa * zcdrag ) ) 
     100         ! 
    91101      ENDIF 
    92102 
    93       qns (:,:) = rn_qns0 
    94       qsr (:,:) = rn_qsr0 
    95       emp (:,:) = rn_emp0 
    96       emps(:,:) = rn_emp0 
    97103    
    98104      ! Increase the surface stress to its nominal value during the first nn_tau000 time-steps 
    … …  
    193199            ! 23.5 deg : tropics 
    194200            qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) ) 
    195             qns (ji,jj) = ztrp * ( tb(ji,jj,1) - t_star ) - qsr(ji,jj) 
     201            qns (ji,jj) = ztrp * ( tsb(ji,jj,1,jp_tem) - t_star ) - qsr(ji,jj) 
    196202            IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg 
    197203               emp  (ji,jj) =   zemp_S * zconv   & 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r2715 r3294  
    1010   !!   sbc_apr        : read atmospheric pressure in netcdf files  
    1111   !!---------------------------------------------------------------------- 
    12    USE bdy_par         ! Unstructured boundary parameters 
    1312   USE obc_par         ! open boundary condition parameters 
    1413   USE dom_oce         ! ocean space and time domain 
    … …  
    3029   !                                         !!* namsbc_apr namelist (Atmospheric PRessure) * 
    3130   LOGICAL, PUBLIC ::   ln_apr_obc = .FALSE.  !: inverse barometer added to OBC ssh data  
    32    LOGICAL, PUBLIC ::   ln_apr_bdy = .FALSE.  !: inverse barometer added to BDY ssh data 
    3331   LOGICAL, PUBLIC ::   ln_ref_apr = .FALSE.  !: ref. pressure: global mean Patm (F) or a constant (F) 
    3432 
    … …  
    115113         ! 
    116114         !                                            !* control check 
    117          IF( ln_apr_obc .OR. ln_apr_bdy  )   & 
    118             CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDY ssh data not yet implemented ' ) 
     115         IF( ln_apr_obc )   & 
     116            CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC ssh data not yet implemented ' ) 
    119117         IF( ln_apr_obc .AND. .NOT. lk_obc )   & 
    120118            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' ) 
    121          IF( ln_apr_bdy .AND. .NOT. lk_bdy )   & 
    122             CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' ) 
    123          IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts )   & 
     119         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   & 
    124120            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 
    125          IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. ln_apr_dyn   )   & 
     121         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   & 
    126122            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 
    127123      ENDIF 

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

    r2777 r3294  
    2727   USE in_out_manager  ! I/O manager 
    2828   USE lib_mpp         ! distribued memory computing library 
     29   USE wrk_nemo        ! work arrays 
     30   USE timing          ! Timing 
    2931   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3032 
    … …  
    207209      !!  ** Nota    :   sf has to be a dummy argument for AGRIF on NEC 
    208210      !!---------------------------------------------------------------------- 
    209       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    210       USE wrk_nemo, ONLY: zqlw => wrk_2d_1  ! long-wave heat flux over ocean 
    211       USE wrk_nemo, ONLY: zqla => wrk_2d_2  ! latent heat flux over ocean 
    212       USE wrk_nemo, ONLY: zqsb => wrk_2d_3  ! sensible heat flux over ocean 
    213       !! 
    214211      TYPE(fld), INTENT(in), DIMENSION(:)       ::   sf    ! input data 
    215212      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius] 
    … …  
    227224      REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         - 
    228225      REAL(wp) ::   ztx2, zty2                                  !    -         - 
     226      REAL(wp), POINTER, DIMENSION(:,:) ::   zqlw        ! long-wave heat flux over ocean 
     227      REAL(wp), POINTER, DIMENSION(:,:) ::   zqla        ! latent heat flux over ocean 
     228      REAL(wp), POINTER, DIMENSION(:,:) ::   zqsb        ! sensible heat flux over ocean 
    229229      !!--------------------------------------------------------------------- 
    230  
    231       IF( wrk_in_use(3, 1,2,3) ) THEN 
    232          CALL ctl_stop('blk_oce_clio: requested workspace arrays are unavailable')   ;   RETURN 
    233       ENDIF 
     230      ! 
     231      IF( nn_timing == 1 )  CALL timing_start('blk_oce_clio') 
     232      ! 
     233      CALL wrk_alloc( jpi,jpj, zqlw, zqla, zqsb ) 
    234234 
    235235      zpatm = 101000._wp      ! atmospheric pressure  (assumed constant here) 
    … …  
    382382      ENDIF 
    383383 
    384       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('blk_oce_clio: failed to release workspace arrays') 
     384      CALL wrk_dealloc( jpi,jpj, zqlw, zqla, zqsb ) 
     385      ! 
     386      IF( nn_timing == 1 )  CALL timing_stop('blk_oce_clio') 
    385387      ! 
    386388   END SUBROUTINE blk_oce_clio 
    … …  
    414416      !! 
    415417      !!---------------------------------------------------------------------- 
    416       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    417       USE wrk_nemo, ONLY:   ztatm  => wrk_2d_1   ! Tair in Kelvin 
    418       USE wrk_nemo, ONLY:   zqatm  => wrk_2d_2   ! specific humidity 
    419       USE wrk_nemo, ONLY:   zevsqr => wrk_2d_3   ! vapour pressure square-root 
    420       USE wrk_nemo, ONLY:   zrhoa  => wrk_2d_4   ! air density 
    421       USE wrk_nemo, ONLY:   wrk_3d_1 , wrk_3d_2 
    422       !! 
    423418      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
    424419      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%] 
    … …  
    448443      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
    449444      !! 
     445      REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin 
     446      REAL(wp), DIMENSION(:,:)  , POINTER ::   zqatm   ! specific humidity 
     447      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevsqr  ! vapour pressure square-root 
     448      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density 
    450449      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
    451450      !!--------------------------------------------------------------------- 
    452  
    453       IF(  wrk_in_use(2, 1,2,3,4)  .OR.  wrk_in_use(3, 1,2)  ) THEN 
    454          CALL ctl_stop('blk_ice_clio: requested workspace arrays are unavailable')   ;   RETURN 
    455       ELSE IF(pdim > jpk)THEN 
    456          CALL ctl_stop('blk_ice_clio: too many ice levels to use wrk_nemo 3D workspaces.') 
    457          RETURN 
    458       END IF 
    459       z_qlw => wrk_3d_1(:,:,1:pdim) 
    460       z_qsb => wrk_3d_2(:,:,1:pdim) 
     451      ! 
     452      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio') 
     453      ! 
     454      CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
     455      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    461456 
    462457      ijpl  = pdim                           ! number of ice categories 
    … …  
    634629      ENDIF 
    635630 
    636       IF( wrk_not_released(2, 1,2,3,4)  .OR.   & 
    637           wrk_not_released(3, 1,2)      )   CALL ctl_stop('blk_ice_clio: failed to release workspace arrays') 
     631      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
     632      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
     633      ! 
     634      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio') 
    638635      ! 
    639636   END SUBROUTINE blk_ice_clio 
    … …  
    650647      !!               - also initialise sbudyko and stauc once for all  
    651648      !!---------------------------------------------------------------------- 
    652       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    653       USE wrk_nemo, ONLY:   zev   => wrk_2d_1                  ! vapour pressure 
    654       USE wrk_nemo, ONLY:   zdlha => wrk_2d_2 , zlsrise => wrk_2d_3 , zlsset => wrk_2d_4  
    655       USE wrk_nemo, ONLY:   zps   => wrk_2d_5 , zpc     => wrk_2d_6   ! sin/cos of latitude per sin/cos of solar declination  
    656       !! 
    657649      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   pqsr_oce    ! shortwave radiation  over the ocean 
    658650      !! 
    … …  
    673665      REAL(wp) ::   zxday, zdist, zcoef, zcoef1      ! 
    674666      REAL(wp) ::   zes 
     667       
     668      REAL(wp), DIMENSION(:,:), POINTER ::   zev          ! vapour pressure 
     669      REAL(wp), DIMENSION(:,:), POINTER ::   zdlha, zlsrise, zlsset     ! 2D workspace 
     670      REAL(wp), DIMENSION(:,:), POINTER ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
    675671      !!--------------------------------------------------------------------- 
    676  
    677       IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 
    678          CALL ctl_stop('blk_clio_qsr_oce: requested workspace arrays unavailable')   ;   RETURN 
    679       END IF 
     672      ! 
     673      IF( nn_timing == 1 )  CALL timing_start('blk_clio_qsr_oce') 
     674      ! 
     675      CALL wrk_alloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 
    680676 
    681677      IF( lbulk_init ) THEN             !   Initilization at first time step only 
    … …  
    791787      END DO 
    792788 
    793       IF( wrk_not_released(2, 1,2,3,4,5,6) )   CALL ctl_stop('blk_clio_qsr_oce: failed to release workspace arrays') 
     789      CALL wrk_dealloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 
     790      ! 
     791      IF( nn_timing == 1 )  CALL timing_stop('blk_clio_qsr_oce') 
    794792      ! 
    795793   END SUBROUTINE blk_clio_qsr_oce 
    … …  
    806804      !!               - also initialise sbudyko and stauc once for all  
    807805      !!---------------------------------------------------------------------- 
    808       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    809       USE wrk_nemo, ONLY:   zev     => wrk_2d_1     ! vapour pressure 
    810       USE wrk_nemo, ONLY:   zdlha   => wrk_2d_2     ! 2D workspace 
    811       USE wrk_nemo, ONLY:   zlsrise => wrk_2d_3     ! 2D workspace 
    812       USE wrk_nemo, ONLY:   zlsset  => wrk_2d_4     ! 2D workspace 
    813       USE wrk_nemo, ONLY:   zps     => wrk_2d_5 , zpc => wrk_2d_6   ! sin/cos of latitude per sin/cos of solar declination  
    814       !! 
    815806      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_cs   ! albedo of ice under clear sky 
    816807      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_os   ! albedo of ice under overcast sky 
    … …  
    830821      REAL(wp) ::   zxday, zdist, zcoef, zcoef1   !    -         - 
    831822      REAL(wp) ::   zqsr_ice_cs, zqsr_ice_os      !    -         - 
     823 
     824      REAL(wp), DIMENSION(:,:), POINTER ::   zev                      ! vapour pressure 
     825      REAL(wp), DIMENSION(:,:), POINTER ::   zdlha, zlsrise, zlsset   ! 2D workspace 
     826      REAL(wp), DIMENSION(:,:), POINTER ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
    832827      !!--------------------------------------------------------------------- 
    833  
    834       IF( wrk_in_use(2, 1,2,3,4,5,6) ) THEN 
    835          CALL ctl_stop('blk_clio_qsr_ice: requested workspace arrays unavailable')   ;   RETURN 
    836       ENDIF 
     828      ! 
     829      IF( nn_timing == 1 )  CALL timing_start('blk_clio_qsr_ice') 
     830      ! 
     831      CALL wrk_alloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 
    837832 
    838833      ijpl = SIZE(pqsr_ice, 3 )      ! number of ice categories 
    … …  
    937932      END DO 
    938933      ! 
    939       IF( wrk_not_released(2, 1,2,3,4,5,6) )   CALL ctl_stop('blk_clio_qsr_ice: failed to release workspace arrays') 
     934      CALL wrk_dealloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc ) 
     935      ! 
     936      IF( nn_timing == 1 )  CALL timing_stop('blk_clio_qsr_ice') 
    940937      ! 
    941938   END SUBROUTINE blk_clio_qsr_ice 

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

    r2777 r3294  
    1414   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put 
    1515   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle 
     16   !!            3.4  !  2011-11  (C. Harris) Fill arrays required by CICE 
    1617   !!---------------------------------------------------------------------- 
    1718 
    … …  
    3233   USE in_out_manager  ! I/O manager 
    3334   USE lib_mpp         ! distribued memory computing library 
     35   USE wrk_nemo        ! work arrays 
     36   USE timing          ! Timing 
    3437   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3538   USE prtctl          ! Print control 
    36 #if defined key_lim3 
     39   USE sbcwave,ONLY :  cdn_wave !wave module  
     40#if defined key_lim3 || defined key_cice 
    3741   USE sbc_ice         ! Surface boundary condition: ice fields 
    3842#endif 
    … …  
    4347   PUBLIC   sbc_blk_core         ! routine called in sbcmod module 
    4448   PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module 
     49   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    4550 
    4651   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read  
    … …  
    182187      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
    183188      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 
     189 
     190#if defined key_cice 
     191      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
     192         qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1)  
     193         qsr_ice(:,:,1)   = sf(jp_qsr)%fnow(:,:,1) 
     194         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)          
     195         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
     196         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
     197         sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac 
     198         wndi_ice(:,:)    = sf(jp_wndi)%fnow(:,:,1) 
     199         wndj_ice(:,:)    = sf(jp_wndj)%fnow(:,:,1) 
     200      ENDIF 
     201#endif 
    184202      ! 
    185203   END SUBROUTINE sbc_blk_core 
    … …  
    207225      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
    208226      !!--------------------------------------------------------------------- 
    209       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    210       USE wrk_nemo, ONLY:   zwnd_i => wrk_2d_1  , zwnd_j => wrk_2d_2      ! wind speed components at T-point 
    211       USE wrk_nemo, ONLY:   zqsatw => wrk_2d_3           ! specific humidity at pst 
    212       USE wrk_nemo, ONLY:   zqlw   => wrk_2d_4  , zqsb   => wrk_2d_5      ! long wave and sensible heat fluxes 
    213       USE wrk_nemo, ONLY:   zqla   => wrk_2d_6  , zevap  => wrk_2d_7      ! latent heat fluxes and evaporation 
    214       USE wrk_nemo, ONLY:   Cd     => wrk_2d_8           ! transfer coefficient for momentum      (tau) 
    215       USE wrk_nemo, ONLY:   Ch     => wrk_2d_9           ! transfer coefficient for sensible heat (Q_sens) 
    216       USE wrk_nemo, ONLY:   Ce     => wrk_2d_10          ! transfer coefficient for evaporation   (Q_lat) 
    217       USE wrk_nemo, ONLY:   zst    => wrk_2d_11          ! surface temperature in Kelvin 
    218       USE wrk_nemo, ONLY:   zt_zu  => wrk_2d_12          ! air temperature at wind speed height 
    219       USE wrk_nemo, ONLY:   zq_zu  => wrk_2d_13          ! air spec. hum.  at wind speed height 
    220       ! 
    221227      TYPE(fld), INTENT(in), DIMENSION(:)   ::   sf    ! input data 
    222228      REAL(wp) , INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
    … …  
    226232      INTEGER  ::   ji, jj               ! dummy loop indices 
    227233      REAL(wp) ::   zcoef_qsatw, zztmp   ! local variable 
     234      REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
     235      REAL(wp), DIMENSION(:,:), POINTER ::   zqsatw            ! specific humidity at pst 
     236      REAL(wp), DIMENSION(:,:), POINTER ::   zqlw, zqsb        ! long wave and sensible heat fluxes 
     237      REAL(wp), DIMENSION(:,:), POINTER ::   zqla, zevap       ! latent heat fluxes and evaporation 
     238      REAL(wp), DIMENSION(:,:), POINTER ::   Cd                ! transfer coefficient for momentum      (tau) 
     239      REAL(wp), DIMENSION(:,:), POINTER ::   Ch                ! transfer coefficient for sensible heat (Q_sens) 
     240      REAL(wp), DIMENSION(:,:), POINTER ::   Ce                ! tansfert coefficient for evaporation   (Q_lat) 
     241      REAL(wp), DIMENSION(:,:), POINTER ::   zst               ! surface temperature in Kelvin 
     242      REAL(wp), DIMENSION(:,:), POINTER ::   zt_zu             ! air temperature at wind speed height 
     243      REAL(wp), DIMENSION(:,:), POINTER ::   zq_zu             ! air spec. hum.  at wind speed height 
    228244      !!--------------------------------------------------------------------- 
    229  
    230       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13) ) THEN 
    231          CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable')   ;   RETURN 
    232       ENDIF 
     245      ! 
     246      IF( nn_timing == 1 )  CALL timing_start('blk_oce_core') 
     247      ! 
     248      CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap ) 
     249      CALL wrk_alloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ) 
    233250      ! 
    234251      ! local scalars ( place there for vector optimisation purposes) 
    … …  
    380397      ENDIF 
    381398      ! 
    382       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13) )   & 
    383           CALL ctl_stop('blk_oce_core: failed to release workspace arrays') 
     399      CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap ) 
     400      CALL wrk_dealloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ) 
     401      ! 
     402      IF( nn_timing == 1 )  CALL timing_stop('blk_oce_core') 
    384403      ! 
    385404   END SUBROUTINE blk_oce_core 
    … …  
    403422      !! caution : the net upward water flux has with mm/day unit 
    404423      !!--------------------------------------------------------------------- 
    405       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    406       USE wrk_nemo, ONLY:   z_wnds_t => wrk_2d_1                ! wind speed ( = | U10m - U_ice | ) at T-point 
    407       USE wrk_nemo, ONLY:   wrk_3d_4 , wrk_3d_5 , wrk_3d_6 , wrk_3d_7 
    408       !! 
    409424      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin] 
    410425      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    … …  
    434449      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    435450      !! 
     451      REAL(wp), DIMENSION(:,:)  , POINTER ::   z_wnds_t          ! wind speed ( = | U10m - U_ice | ) at T-point 
    436452      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
    437453      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
    … …  
    439455      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
    440456      !!--------------------------------------------------------------------- 
     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 )  
    441462 
    442463      ijpl  = pdim                            ! number of ice categories 
    443  
    444       ! Set-up access to workspace arrays 
    445       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 4,5,6,7) ) THEN 
    446          CALL ctl_stop('blk_ice_core: requested workspace arrays unavailable')   ;   RETURN 
    447       ELSE IF(ijpl > jpk) THEN 
    448          CALL ctl_stop('blk_ice_core: no. of ice categories > jpk so wrk_nemo 3D workspaces cannot be used.') 
    449          RETURN 
    450       END IF 
    451       ! Set-up pointers to sub-arrays of workspaces 
    452       z_qlw  => wrk_3d_4(:,:,1:ijpl) 
    453       z_qsb  => wrk_3d_5(:,:,1:ijpl) 
    454       z_dqlw => wrk_3d_6(:,:,1:ijpl) 
    455       z_dqsb => wrk_3d_7(:,:,1:ijpl) 
    456464 
    457465      ! local scalars ( place there for vector optimisation purposes) 
    … …  
    606614      ENDIF 
    607615 
    608       IF( wrk_not_released(2, 1)       .OR.   & 
    609           wrk_not_released(3, 4,5,6,7) )   CALL ctl_stop('blk_ice_core: failed to release workspace arrays') 
     616      CALL wrk_dealloc( jpi,jpj, z_wnds_t ) 
     617      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )  
     618      ! 
     619      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core') 
    610620      ! 
    611621   END SUBROUTINE blk_ice_core 
    … …  
    628638      !! References :   Large & Yeager, 2004 : ??? 
    629639      !!---------------------------------------------------------------------- 
    630       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    631       USE wrk_nemo, ONLY: dU10 => wrk_2d_14        ! dU                             [m/s] 
    632       USE wrk_nemo, ONLY: dT => wrk_2d_15          ! air/sea temperature difference   [K] 
    633       USE wrk_nemo, ONLY: dq => wrk_2d_16          ! air/sea humidity difference      [K] 
    634       USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_17      ! 10m neutral drag coefficient 
    635       USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_18      ! 10m neutral latent coefficient 
    636       USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_19      ! 10m neutral sensible coefficient 
    637       USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_20 ! root square of Cd_n10 
    638       USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_21     ! root square of Cd 
    639       USE wrk_nemo, ONLY: T_vpot => wrk_2d_22      ! virtual potential temperature    [K] 
    640       USE wrk_nemo, ONLY: T_star => wrk_2d_23      ! turbulent scale of tem. fluct. 
    641       USE wrk_nemo, ONLY: q_star => wrk_2d_24      ! turbulent humidity of temp. fluct. 
    642       USE wrk_nemo, ONLY: U_star => wrk_2d_25      ! turb. scale of velocity fluct. 
    643       USE wrk_nemo, ONLY: L => wrk_2d_26           ! Monin-Obukov length              [m] 
    644       USE wrk_nemo, ONLY: zeta => wrk_2d_27        ! stability parameter at height zu 
    645       USE wrk_nemo, ONLY: U_n10 => wrk_2d_28       ! neutral wind velocity at 10m     [m] 
    646       USE wrk_nemo, ONLY: xlogt  => wrk_2d_29,    xct => wrk_2d_30,   & 
    647                           zpsi_h => wrk_2d_31, zpsi_m => wrk_2d_32 
    648       USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
    649       ! 
    650640      REAL(wp)                , INTENT(in   ) ::   zu      ! altitude of wind measurement       [m] 
    651641      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sst     ! sea surface temperature         [Kelvin] 
    … …  
    662652      REAL(wp), PARAMETER ::   grav   = 9.8   ! gravity                        
    663653      REAL(wp), PARAMETER ::   kappa  = 0.4   ! von Karman s constant 
     654 
     655      REAL(wp), DIMENSION(:,:), POINTER  ::   dU10          ! dU                                   [m/s] 
     656      REAL(wp), DIMENSION(:,:), POINTER  ::   dT            ! air/sea temperature differeence      [K] 
     657      REAL(wp), DIMENSION(:,:), POINTER  ::   dq            ! air/sea humidity difference          [K] 
     658      REAL(wp), DIMENSION(:,:), POINTER  ::   Cd_n10        ! 10m neutral drag coefficient 
     659      REAL(wp), DIMENSION(:,:), POINTER  ::   Ce_n10        ! 10m neutral latent coefficient 
     660      REAL(wp), DIMENSION(:,:), POINTER  ::   Ch_n10        ! 10m neutral sensible coefficient 
     661      REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd_n10   ! root square of Cd_n10 
     662      REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd       ! root square of Cd 
     663      REAL(wp), DIMENSION(:,:), POINTER  ::   T_vpot        ! virtual potential temperature        [K] 
     664      REAL(wp), DIMENSION(:,:), POINTER  ::   T_star        ! turbulent scale of tem. fluct. 
     665      REAL(wp), DIMENSION(:,:), POINTER  ::   q_star        ! turbulent humidity of temp. fluct. 
     666      REAL(wp), DIMENSION(:,:), POINTER  ::   U_star        ! turb. scale of velocity fluct. 
     667      REAL(wp), DIMENSION(:,:), POINTER  ::   L             ! Monin-Obukov length                  [m] 
     668      REAL(wp), DIMENSION(:,:), POINTER  ::   zeta          ! stability parameter at height zu 
     669      REAL(wp), DIMENSION(:,:), POINTER  ::   U_n10         ! neutral wind velocity at 10m         [m]    
     670      REAL(wp), DIMENSION(:,:), POINTER  ::   xlogt, xct, zpsi_h, zpsi_m 
     671       
     672      INTEGER , DIMENSION(:,:), POINTER  ::   stab          ! 1st guess stability test integer 
    664673      !!---------------------------------------------------------------------- 
    665  
    666       IF(  wrk_in_use(2,             14,15,16,17,18,19,        & 
    667                          20,21,22,23,24,25,26,27,28,29,        & 
    668                          30,31,32)                      .OR.   & 
    669           iwrk_in_use(2, 1)                               ) THEN 
    670          CALL ctl_stop('TURB_CORE_1Z: requested workspace arrays unavailable')   ;   RETURN 
    671       ENDIF 
     674      ! 
     675      IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_1Z') 
     676      ! 
     677      CALL wrk_alloc( jpi,jpj, stab )   ! integer 
     678      CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
     679      CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m ) 
    672680 
    673681      !! * Start 
    … …  
    682690      !! Neutral Drag Coefficient 
    683691      stab    = 0.5 + sign(0.5,dT)    ! stable : stab = 1 ; unstable : stab = 0  
    684       Cd_n10  = 1E-3 * ( 2.7/dU10 + 0.142 + dU10/13.09 )    !   L & Y eq. (6a) 
     692      IF  ( ln_cdgw ) THEN 
     693        cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1) 
     694        Cd_n10(:,:) =   cdn_wave 
     695      ELSE 
     696        Cd_n10  = 1E-3 * ( 2.7/dU10 + 0.142 + dU10/13.09 )    !   L & Y eq. (6a) 
     697      ENDIF 
    685698      sqrt_Cd_n10 = sqrt(Cd_n10) 
    686699      Ce_n10  = 1E-3 * ( 34.6 * sqrt_Cd_n10 )               !   L & Y eq. (6b) 
    … …  
    705718         zpsi_m  = psi_m(zeta) 
    706719 
    707          !! Shifting the wind speed to 10m and neutral stability : 
    708          U_n10 = dU10*1./(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) !  L & Y eq. (9a) 
    709  
    710          !! Updating the neutral 10m transfer coefficients : 
    711          Cd_n10  = 1E-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)              !  L & Y eq. (6a) 
    712          sqrt_Cd_n10 = sqrt(Cd_n10) 
    713          Ce_n10  = 1E-3 * (34.6 * sqrt_Cd_n10)                           !  L & Y eq. (6b) 
    714          stab    = 0.5 + sign(0.5,zeta) 
    715          Ch_n10  = 1E-3*sqrt_Cd_n10*(18.*stab + 32.7*(1-stab))           !  L & Y eq. (6c), (6d) 
    716  
    717          !! Shifting the neutral  10m transfer coefficients to ( zu , zeta ) : 
    718          !! 
    719          xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10) - zpsi_m) 
    720          Cd  = Cd_n10/(xct*xct) ;  sqrt_Cd = sqrt(Cd) 
     720         IF  ( ln_cdgw ) THEN 
     721           sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
     722         ELSE 
     723           !! Shifting the wind speed to 10m and neutral stability : 
     724           U_n10 = dU10*1./(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) !  L & Y eq. (9a) 
     725 
     726           !! Updating the neutral 10m transfer coefficients : 
     727           Cd_n10  = 1E-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)              !  L & Y eq. (6a) 
     728           sqrt_Cd_n10 = sqrt(Cd_n10) 
     729           Ce_n10  = 1E-3 * (34.6 * sqrt_Cd_n10)                           !  L & Y eq. (6b) 
     730           stab    = 0.5 + sign(0.5,zeta) 
     731           Ch_n10  = 1E-3*sqrt_Cd_n10*(18.*stab + 32.7*(1-stab))           !  L & Y eq. (6c), (6d) 
     732 
     733           !! Shifting the neutral  10m transfer coefficients to ( zu , zeta ) : 
     734           !! 
     735           xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10) - zpsi_m) 
     736           Cd  = Cd_n10/(xct*xct) ;  sqrt_Cd = sqrt(Cd) 
     737         ENDIF 
    721738         !! 
    722739         xlogt = log(zu/10.) - zpsi_h 
    … …  
    730747      END DO 
    731748      !! 
    732       IF( wrk_not_released(2,             14,15,16,17,18,19,          & 
    733          &                    20,21,22,23,24,25,26,27,28,29,          & 
    734          &                    30,31,32                      )   .OR.  &       
    735          iwrk_not_released(2, 1)                                  )   & 
    736          CALL ctl_stop('TURB_CORE_1Z: failed to release workspace arrays') 
     749      CALL wrk_dealloc( jpi,jpj, stab )   ! integer 
     750      CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
     751      CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m ) 
     752      ! 
     753      IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_1Z') 
    737754      ! 
    738755    END SUBROUTINE TURB_CORE_1Z 
    … …  
    754771      !! References :   Large & Yeager, 2004 : ??? 
    755772      !!---------------------------------------------------------------------- 
    756       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    757       USE wrk_nemo, ONLY: dU10 => wrk_2d_14        ! dU                             [m/s] 
    758       USE wrk_nemo, ONLY: dT => wrk_2d_15          ! air/sea temperature difference   [K] 
    759       USE wrk_nemo, ONLY: dq => wrk_2d_16          ! air/sea humidity difference      [K] 
    760       USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_17      ! 10m neutral drag coefficient 
    761       USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_18      ! 10m neutral latent coefficient 
    762       USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_19      ! 10m neutral sensible coefficient 
    763       USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_20 ! root square of Cd_n10 
    764       USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_21     ! root square of Cd 
    765       USE wrk_nemo, ONLY: T_vpot => wrk_2d_22      ! virtual potential temperature    [K] 
    766       USE wrk_nemo, ONLY: T_star => wrk_2d_23     ! turbulent scale of tem. fluct. 
    767       USE wrk_nemo, ONLY: q_star => wrk_2d_24     ! turbulent humidity of temp. fluct. 
    768       USE wrk_nemo, ONLY: U_star => wrk_2d_25     ! turb. scale of velocity fluct. 
    769       USE wrk_nemo, ONLY: L => wrk_2d_26          ! Monin-Obukov length              [m] 
    770       USE wrk_nemo, ONLY: zeta_u => wrk_2d_27     ! stability parameter at height zu 
    771       USE wrk_nemo, ONLY: zeta_t => wrk_2d_28     ! stability parameter at height zt 
    772       USE wrk_nemo, ONLY: U_n10 => wrk_2d_29      ! neutral wind velocity at 10m     [m] 
    773       USE wrk_nemo, ONLY: xlogt => wrk_2d_30, xct => wrk_2d_31, zpsi_hu => wrk_2d_32, zpsi_ht => wrk_2d_33, zpsi_m => wrk_2d_34 
    774       USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
    775       !! 
    776       REAL(wp), INTENT(in)   :: & 
    777          zt,      &     ! height for T_zt and q_zt                   [m] 
    778          zu             ! height for dU                              [m] 
    779       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::  & 
    780          sst,      &     ! sea surface temperature              [Kelvin] 
    781          T_zt,     &     ! potential air temperature            [Kelvin] 
    782          q_sat,    &     ! sea surface specific humidity         [kg/kg] 
    783          q_zt,     &     ! specific air humidity                 [kg/kg] 
    784          dU              ! relative wind module |U(zu)-U(0)|       [m/s] 
    785       REAL(wp), INTENT(out), DIMENSION(jpi,jpj)  ::  & 
    786          Cd,       &     ! transfer coefficient for momentum         (tau) 
    787          Ch,       &     ! transfer coefficient for sensible heat (Q_sens) 
    788          Ce,       &     ! transfert coefficient for evaporation   (Q_lat) 
    789          T_zu,     &     ! air temp. shifted at zu                     [K] 
    790          q_zu            ! spec. hum.  shifted at zu               [kg/kg] 
     773      REAL(wp), INTENT(in   )                     ::   zt       ! height for T_zt and q_zt                   [m] 
     774      REAL(wp), INTENT(in   )                     ::   zu       ! height for dU                              [m] 
     775      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature              [Kelvin] 
     776      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   T_zt     ! potential air temperature            [Kelvin] 
     777      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_sat    ! sea surface specific humidity         [kg/kg] 
     778      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                 [kg/kg] 
     779      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   dU       ! relative wind module |U(zu)-U(0)|       [m/s] 
     780      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
     781      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens) 
     782      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat) 
     783      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   T_zu     ! air temp. shifted at zu                     [K] 
     784      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. hum.  shifted at zu               [kg/kg] 
    791785 
    792786      INTEGER :: j_itt 
    793       INTEGER, PARAMETER :: nb_itt = 3   ! number of itterations 
    794       REAL(wp), PARAMETER ::                        & 
    795          grav   = 9.8,      &  ! gravity                        
    796          kappa  = 0.4          ! von Karman's constant 
     787      INTEGER , PARAMETER :: nb_itt = 3              ! number of itterations 
     788      REAL(wp), PARAMETER ::   grav   = 9.8          ! gravity                        
     789      REAL(wp), PARAMETER ::   kappa  = 0.4          ! von Karman's constant 
     790       
     791      REAL(wp), DIMENSION(:,:), POINTER ::   dU10          ! dU                                [m/s] 
     792      REAL(wp), DIMENSION(:,:), POINTER ::   dT            ! air/sea temperature differeence   [K] 
     793      REAL(wp), DIMENSION(:,:), POINTER ::   dq            ! air/sea humidity difference       [K] 
     794      REAL(wp), DIMENSION(:,:), POINTER ::   Cd_n10        ! 10m neutral drag coefficient 
     795      REAL(wp), DIMENSION(:,:), POINTER ::   Ce_n10        ! 10m neutral latent coefficient 
     796      REAL(wp), DIMENSION(:,:), POINTER ::   Ch_n10        ! 10m neutral sensible coefficient 
     797      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd_n10   ! root square of Cd_n10 
     798      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd       ! root square of Cd 
     799      REAL(wp), DIMENSION(:,:), POINTER ::   T_vpot        ! virtual potential temperature        [K] 
     800      REAL(wp), DIMENSION(:,:), POINTER ::   T_star        ! turbulent scale of tem. fluct. 
     801      REAL(wp), DIMENSION(:,:), POINTER ::   q_star        ! turbulent humidity of temp. fluct. 
     802      REAL(wp), DIMENSION(:,:), POINTER ::   U_star        ! turb. scale of velocity fluct. 
     803      REAL(wp), DIMENSION(:,:), POINTER ::   L             ! Monin-Obukov length                  [m] 
     804      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_u        ! stability parameter at height zu 
     805      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_t        ! stability parameter at height zt 
     806      REAL(wp), DIMENSION(:,:), POINTER ::   U_n10         ! neutral wind velocity at 10m        [m] 
     807      REAL(wp), DIMENSION(:,:), POINTER ::   xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m 
     808 
     809      INTEGER , DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer 
    797810      !!---------------------------------------------------------------------- 
    798       !!  * Start 
    799  
    800       IF(  wrk_in_use(2,             14,15,16,17,18,19,        & 
    801                          20,21,22,23,24,25,26,27,28,29,        &          
    802                          30,31,32,33,34)                .OR.   & 
    803           iwrk_in_use(2, 1)                               ) THEN 
    804          CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable')   ;   RETURN 
    805       ENDIF 
     811      ! 
     812      IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_2Z') 
     813      ! 
     814      CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
     815      CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 ) 
     816      CALL wrk_alloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m ) 
     817      CALL wrk_alloc( jpi,jpj, stab )   ! interger 
    806818 
    807819      !! Initial air/sea differences 
    … …  
    812824      !! Neutral Drag Coefficient : 
    813825      stab = 0.5 + sign(0.5,dT)                 ! stab = 1  if dT > 0  -> STABLE 
    814       Cd_n10  = 1E-3*( 2.7/dU10 + 0.142 + dU10/13.09 )  
     826      IF( ln_cdgw ) THEN 
     827        cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1) 
     828        Cd_n10(:,:) =   cdn_wave 
     829      ELSE 
     830        Cd_n10  = 1E-3*( 2.7/dU10 + 0.142 + dU10/13.09 )  
     831      ENDIF 
    815832      sqrt_Cd_n10 = sqrt(Cd_n10) 
    816833      Ce_n10  = 1E-3*( 34.6 * sqrt_Cd_n10 ) 
    … …  
    853870         stab = 0.5 + sign(0.5,q_zu) ;  q_zu = stab*q_zu 
    854871         !! 
    855          !! Updating the neutral 10m transfer coefficients : 
    856          Cd_n10  = 1E-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)    ! L & Y eq. (6a) 
    857          sqrt_Cd_n10 = sqrt(Cd_n10) 
    858          Ce_n10  = 1E-3 * (34.6 * sqrt_Cd_n10)                 ! L & Y eq. (6b) 
    859          stab    = 0.5 + sign(0.5,zeta_u) 
    860          Ch_n10  = 1E-3*sqrt_Cd_n10*(18.*stab + 32.7*(1-stab)) ! L & Y eq. (6c-6d) 
    861          !! 
    862          !! 
    863          !! Shifting the neutral 10m transfer coefficients to (zu,zeta_u) : 
    864 !        xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10.) - psi_m(zeta_u)) 
    865          xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m) 
    866          Cd = Cd_n10/(xct*xct) ; sqrt_Cd = sqrt(Cd) 
    867          !! 
    868 !        xlogt = log(zu/10.) - psi_h(zeta_u) 
     872         IF( ln_cdgw ) THEN 
     873            sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
     874         ELSE 
     875           !! Updating the neutral 10m transfer coefficients : 
     876           Cd_n10  = 1E-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)    ! L & Y eq. (6a) 
     877           sqrt_Cd_n10 = sqrt(Cd_n10) 
     878           Ce_n10  = 1E-3 * (34.6 * sqrt_Cd_n10)                 ! L & Y eq. (6b) 
     879           stab    = 0.5 + sign(0.5,zeta_u) 
     880           Ch_n10  = 1E-3*sqrt_Cd_n10*(18.*stab + 32.7*(1-stab)) ! L & Y eq. (6c-6d) 
     881           !! 
     882           !! 
     883           !! Shifting the neutral 10m transfer coefficients to (zu,zeta_u) : 
     884           xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m) 
     885           Cd = Cd_n10/(xct*xct) ; sqrt_Cd = sqrt(Cd) 
     886         ENDIF 
     887         !! 
    869888         xlogt = log(zu/10.) - zpsi_hu 
    870889         !! 
    … …  
    878897      END DO 
    879898      !! 
    880      IF( wrk_not_released(2,              14,15,16,17,18,19,          & 
    881          &                    20,21,22,23,24,25,26,27,28,29,          & 
    882          &                    30,31,32,33,34                )   .OR.  &   
    883          iwrk_not_released(2, 1)                                  )   & 
    884          CALL ctl_stop('TURB_CORE_2Z: failed to release workspace arrays') 
     899      CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L ) 
     900      CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 ) 
     901      CALL wrk_dealloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m ) 
     902      CALL wrk_dealloc( jpi,jpj, stab )   ! interger 
     903      ! 
     904      IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_2Z') 
    885905      ! 
    886906    END SUBROUTINE TURB_CORE_2Z 
    … …  
    889909    FUNCTION psi_m(zta)   !! Psis, L & Y eq. (8c), (8d), (8e) 
    890910      !------------------------------------------------------------------------------- 
    891       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    892       USE wrk_nemo, ONLY:     X2 => wrk_2d_35 
    893       USE wrk_nemo, ONLY:     X  => wrk_2d_36 
    894       USE wrk_nemo, ONLY: stabit => wrk_2d_37 
    895       !! 
    896911      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    897912 
    898913      REAL(wp), PARAMETER :: pi = 3.141592653589793_wp 
    899914      REAL(wp), DIMENSION(jpi,jpj)             :: psi_m 
     915      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
    900916      !------------------------------------------------------------------------------- 
    901917 
    902       IF( wrk_in_use(2, 35,36,37) ) THEN 
    903          CALL ctl_stop('psi_m: requested workspace arrays unavailable')   ;   RETURN 
    904       ENDIF 
     918      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    905919 
    906920      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2) 
    … …  
    909923         &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
    910924 
    911       IF( wrk_not_released(2, 35,36,37) )   CALL ctl_stop('psi_m: failed to release workspace arrays') 
     925      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    912926      ! 
    913927    END FUNCTION psi_m 
    … …  
    916930    FUNCTION psi_h( zta )    !! Psis, L & Y eq. (8c), (8d), (8e) 
    917931      !------------------------------------------------------------------------------- 
    918       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    919       USE wrk_nemo, ONLY:     X2 => wrk_2d_35 
    920       USE wrk_nemo, ONLY:     X  => wrk_2d_36 
    921       USE wrk_nemo, ONLY: stabit => wrk_2d_37 
    922       ! 
    923932      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta 
    924933      ! 
    925934      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_h 
     935      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit 
    926936      !------------------------------------------------------------------------------- 
    927937 
    928       IF( wrk_in_use(2, 35,36,37) ) THEN 
    929          CALL ctl_stop('psi_h: requested workspace arrays unavailable')   ;   RETURN 
    930       ENDIF 
     938      CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 
    931939 
    932940      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2) 
    … …  
    935943         &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
    936944 
    937       IF( wrk_not_released(2, 35,36,37) )   CALL ctl_stop('psi_h: failed to release workspace arrays') 
     945      CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 
    938946      ! 
    939947    END FUNCTION psi_h 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r3292 r3294  
    2020   USE in_out_manager  ! I/O manager 
    2121   USE lib_mpp         ! distribued memory computing library 
     22   USE wrk_nemo        ! work arrays 
     23   USE timing          ! Timing 
    2224   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2325   USE prtctl          ! Print control 
    … …  
    119121         &                  sn_tair , sn_rhm , sn_prec  
    120122      !!--------------------------------------------------------------------- 
    121  
     123      ! 
     124      IF( nn_timing == 1 )  CALL timing_start('sbc_blk_mfs') 
     125      ! 
    122126      !                                         ! ====================== ! 
    123127      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    … …  
    262266 
    263267      ENDIF 
    264  
     268      ! 
     269      IF( nn_timing == 1 )  CALL timing_stop('sbc_blk_mfs') 
     270      ! 
    265271   END SUBROUTINE sbc_blk_mfs 
    266272   
    … …  
    283289      !! 
    284290      !!---------------------------------------------------------------------- 
    285       !! 
    286  
    287291      USE sbcblk_core, ONLY: turb_core_2z ! For wave coupling and Tair/rh from 2 to 10m 
    288       USE wrk_nemo, ONLY:  wrk_in_use, wrk_not_released 
    289       USE wrk_nemo, ONLY:  rspeed     => wrk_2d_1 
    290       USE wrk_nemo, ONLY:  sh10now    => wrk_2d_2 
    291       USE wrk_nemo, ONLY:  t10now     => wrk_2d_3 
    292       USE wrk_nemo, ONLY:  cdx        => wrk_2d_4   ! --- drag coeff. 
    293       USE wrk_nemo, ONLY:  ce         => wrk_2d_5   ! --- turbulent exchange coefficients 
    294       USE wrk_nemo, ONLY:  shms       => wrk_2d_6 
    295       USE wrk_nemo, ONLY:  rhom       => wrk_2d_7 
    296       USE wrk_nemo, ONLY:  sstk       => wrk_2d_8 
    297       USE wrk_nemo, ONLY:  ch         => wrk_2d_10 
    298       USE wrk_nemo, ONLY:  rel_windu  => wrk_2d_11 
    299       USE wrk_nemo, ONLY:  rel_windv  => wrk_2d_12 
    300292 
    301293      REAL(wp), INTENT(in   ) :: hour 
    … …  
    310302      REAL(wp)  :: esre, cseep 
    311303 
     304      REAL(wp), DIMENSION (:,:), POINTER ::   rspeed, sh10now, t10now, cdx, ce, shms 
     305      REAL(wp), DIMENSION (:,:), POINTER ::   rhom, sstk, ch, rel_windu, rel_windv 
    312306      !!---------------------------------------------------------------------- 
    313307      !!     coefficients ( in MKS )  : 
    … …  
    335329      REAL(wp), DIMENSION(5) :: p_e = (/-0.16,1.0,1.0,1.0,1.0/) 
    336330      INTEGER :: kku                        !index varing with wind speed 
    337  
    338       ! Set-up access to workspace arrays 
    339       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,10,11,12) ) THEN 
    340          CALL ctl_stop('blk_mfs: requested workspace arrays unavailable')   ;   RETURN 
    341       END IF 
     331      ! 
     332      IF( nn_timing == 1 )  CALL timing_start('fluxes_mfs') 
     333      ! 
     334      CALL wrk_alloc( jpi,jpj, rspeed, sh10now, t10now, cdx, ce, shms ) 
     335      CALL wrk_alloc( jpi,jpj, rhom, sstk, ch, rel_windu, rel_windv ) 
    342336 
    343337      !!---------------------------------------------------------------------- 
    … …  
    501495       tauy(:,:)= rhom(:,:) * cdx(:,:) * rspeed(:,:) * rel_windv(:,:) 
    502496 
    503  
    504       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,10,11,12) )    & 
    505          CALL ctl_stop('fluxes_mfs: failed to release workspace arrays') 
    506  
    507  
     497      CALL wrk_dealloc( jpi,jpj, rspeed, sh10now, t10now, cdx, ce, shms ) 
     498      CALL wrk_dealloc( jpi,jpj, rhom, sstk, ch, rel_windu, rel_windv ) 
     499      ! 
     500      IF( nn_timing == 1 )  CALL timing_stop('fluxes_mfs') 
     501      ! 
    508502   END SUBROUTINE fluxes_mfs 
    509503 

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

    r2715 r3294  
    77   !!            3.0  ! 2008-02  (G. Madec, C Talandier)  surface module 
    88   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface 
     9   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_oasis3 || defined key_oasis4 
    … …  
    4142   USE geo2ocean       !  
    4243   USE restart         ! 
    43    USE oce   , ONLY : tn, un, vn 
     44   USE oce   , ONLY : tsn, un, vn 
    4445   USE albedo          ! 
    4546   USE in_out_manager  ! I/O manager 
    4647   USE iom             ! NetCDF library 
    4748   USE lib_mpp         ! distribued memory computing library 
     49   USE wrk_nemo        ! work arrays 
     50   USE timing          ! Timing 
    4851   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4952#if defined key_cpl_carbon_cycle 
    … …  
    5154#endif 
    5255   USE diaar5, ONLY :   lk_diaar5 
     56#if defined key_cice 
     57   USE ice_domain_size, only: ncat 
     58#endif 
    5359   IMPLICIT NONE 
    5460   PRIVATE 
    … …  
    8995   INTEGER, PARAMETER ::   jpr_cal    = 29            ! calving 
    9096   INTEGER, PARAMETER ::   jpr_taum   = 30            ! wind stress module 
    91 #if ! defined key_cpl_carbon_cycle 
    92    INTEGER, PARAMETER ::   jprcv      = 30            ! total number of fields received 
    93 #else 
    9497   INTEGER, PARAMETER ::   jpr_co2    = 31 
    95    INTEGER, PARAMETER ::   jprcv      = 31            ! total number of fields received 
    96 #endif    
     98   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
     99   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
     100   INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
     101 
    97102   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
    98103   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    … …  
    109114   INTEGER, PARAMETER ::   jps_ivy1   = 13            ! 
    110115   INTEGER, PARAMETER ::   jps_ivz1   = 14            ! 
    111 #if ! defined key_cpl_carbon_cycle 
    112    INTEGER, PARAMETER ::   jpsnd      = 14            ! total number of fields sended 
    113 #else 
    114116   INTEGER, PARAMETER ::   jps_co2    = 15 
    115117   INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended 
    116 #endif    
     118 
    117119   !                                                         !!** namelist namsbc_cpl ** 
    118    ! Send to the atmosphere                                   ! 
    119    CHARACTER(len=100) ::   cn_snd_temperature = 'oce only'    ! 'oce only' 'weighted oce and ice' or 'mixed oce-ice' 
    120    CHARACTER(len=100) ::   cn_snd_albedo      = 'none'        ! 'none' 'weighted ice' or 'mixed oce-ice' 
    121    CHARACTER(len=100) ::   cn_snd_thickness   = 'none'        ! 'none' or 'weighted ice and snow' 
    122    CHARACTER(len=100) ::   cn_snd_crt_nature  = 'none'        ! 'none' 'oce only' 'weighted oce and ice' or 'mixed oce-ice'    
    123    CHARACTER(len=100) ::   cn_snd_crt_refere  = 'spherical'   ! 'spherical' or 'cartesian' 
    124    CHARACTER(len=100) ::   cn_snd_crt_orient  = 'local grid'  ! 'eastward-northward' or 'local grid' 
    125    CHARACTER(len=100) ::   cn_snd_crt_grid    = 'T'           ! always at 'T' point 
    126 #if defined key_cpl_carbon_cycle  
    127    CHARACTER(len=100) ::   cn_snd_co2         = 'none'        ! 'none' or 'coupled' 
     120   TYPE ::   FLD_C 
     121      CHARACTER(len = 32) ::   cldes                  ! desciption of the coupling strategy 
     122      CHARACTER(len = 32) ::   clcat                  ! multiple ice categories strategy 
     123      CHARACTER(len = 32) ::   clvref                 ! reference of vector ('spherical' or 'cartesian') 
     124      CHARACTER(len = 32) ::   clvor                  ! orientation of vector fields ('eastward-northward' or 'local grid') 
     125      CHARACTER(len = 32) ::   clvgrd                 ! grids on which is located the vector fields 
     126   END TYPE FLD_C 
     127   ! Send to the atmosphere                           ! 
     128   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                         
     129   ! Received from the atmosphere                     ! 
     130   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
     131   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     132 
     133   TYPE ::   DYNARR      
     134      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
     135   END TYPE DYNARR 
     136 
     137   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                      ! all fields recieved from the atmosphere 
     138 
     139   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
     140 
     141   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
     142 
     143#if ! defined key_lim2   &&   ! defined key_lim3 
     144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     145   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    128146#endif 
    129    ! Received from the atmosphere                             ! 
    130    CHARACTER(len=100) ::   cn_rcv_tau_nature  = 'oce only'    ! 'oce only' 'oce and ice' or 'mixed oce-ice' 
    131    CHARACTER(len=100) ::   cn_rcv_tau_refere  = 'spherical'   ! 'spherical' or 'cartesian' 
    132    CHARACTER(len=100) ::   cn_rcv_tau_orient  = 'local grid'  ! 'eastward-northward' or 'local grid' 
    133    CHARACTER(len=100) ::   cn_rcv_tau_grid    = 'T'           ! 'T', 'U,V', 'U,V,I', 'T,I', or 'T,U,V' 
    134    CHARACTER(len=100) ::   cn_rcv_w10m        = 'none'        ! 'none' or 'coupled' 
    135    CHARACTER(len=100) ::   cn_rcv_dqnsdt      = 'none'        ! 'none' or 'coupled' 
    136    CHARACTER(len=100) ::   cn_rcv_qsr         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 
    137    CHARACTER(len=100) ::   cn_rcv_qns         = 'oce only'    ! 'oce only' 'conservative' 'oce and ice' or 'mixed oce-ice' 
    138    CHARACTER(len=100) ::   cn_rcv_emp         = 'oce only'    ! 'oce only' 'conservative' or 'oce and ice' 
    139    CHARACTER(len=100) ::   cn_rcv_rnf         = 'coupled'     ! 'coupled' 'climato' or 'mixed' 
    140    CHARACTER(len=100) ::   cn_rcv_cal         = 'none'        ! 'none' or 'coupled' 
    141    CHARACTER(len=100) ::   cn_rcv_taumod      = 'none'        ! 'none' or 'coupled' 
    142 #if defined key_cpl_carbon_cycle  
    143    CHARACTER(len=100) ::   cn_rcv_co2         = 'none'        ! 'none' or 'coupled' 
     147 
     148#if defined key_cice 
     149   INTEGER, PARAMETER ::   jpl = ncat 
     150#elif ! defined key_lim2   &&   ! defined key_lim3 
     151   INTEGER, PARAMETER ::   jpl = 1  
     152   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    144154#endif 
    145155 
    146 !!   CHARACTER(len=100), PUBLIC ::   cn_rcv_rnf   !: ???             ==>>  !!gm   treat this case in a different maner 
    147     
    148    CHARACTER(len=100), DIMENSION(4) ::   cn_snd_crt           ! array combining cn_snd_crt_* 
    149    CHARACTER(len=100), DIMENSION(4) ::   cn_rcv_tau           ! array combining cn_rcv_tau_* 
    150  
    151    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
    152  
    153    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   frcv               ! all fields recieved from the atmosphere 
    154    INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    155  
    156 #if ! defined key_lim2   &&   ! defined key_lim3 
    157    ! quick patch to be able to run the coupled model without sea-ice... 
    158    INTEGER, PARAMETER ::   jpl = 1  
    159    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 
    160    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice ! (jpi,jpj,jpl) 
    161    REAL(wp) ::  lfus 
     156#if ! defined key_lim3   &&  ! defined key_cice 
     157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     158#endif 
     159 
     160#if ! defined key_lim3 
     161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
     162#endif 
     163 
     164#if ! defined key_cice 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
    162166#endif 
    163167 
    … …  
    176180      !!             ***  FUNCTION sbc_cpl_alloc  *** 
    177181      !!---------------------------------------------------------------------- 
    178       INTEGER :: ierr(2) 
     182      INTEGER :: ierr(4),jn 
    179183      !!---------------------------------------------------------------------- 
    180184      ierr(:) = 0 
    181185      ! 
    182       ALLOCATE( albedo_oce_mix(jpi,jpj), frcv(jpi,jpj,jprcv), nrcvinfo(jprcv),  STAT=ierr(1) ) 
     186      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    183187      ! 
    184188#if ! defined key_lim2 && ! defined key_lim3 
    185189      ! quick patch to be able to run the coupled model without sea-ice... 
    186       ALLOCATE( hicif(jpi,jpj) , u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,jpl) ,     & 
    187                 hsnif(jpi,jpj) , v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,jpl) , STAT=ierr(2) ) 
     190      ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     & 
     191                v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      & 
     192                emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 
     193#endif 
     194 
     195#if ! defined key_lim3 && ! defined key_cice 
     196      ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 
     197#endif 
     198 
     199#if defined key_cice || defined key_lim2 
     200      ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    188201#endif 
    189202      sbc_cpl_alloc = MAXVAL( ierr ) 
    … …  
    206219      !!              * initialise the OASIS coupler 
    207220      !!---------------------------------------------------------------------- 
    208       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    209       USE wrk_nemo, ONLY:   zacs => wrk_2d_3 , zaos => wrk_2d_4   ! clear & overcast sky albedos 
    210       !! 
    211221      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    212222      !! 
    213223      INTEGER ::   jn   ! dummy loop index 
    214       !! 
    215       NAMELIST/namsbc_cpl/  cn_snd_temperature, cn_snd_albedo    , cn_snd_thickness,                 &           
    216          cn_snd_crt_nature, cn_snd_crt_refere , cn_snd_crt_orient, cn_snd_crt_grid ,                 & 
    217          cn_rcv_w10m      , cn_rcv_taumod     ,                                                      & 
    218          cn_rcv_tau_nature, cn_rcv_tau_refere , cn_rcv_tau_orient, cn_rcv_tau_grid ,                 & 
    219          cn_rcv_dqnsdt    , cn_rcv_qsr        , cn_rcv_qns       , cn_rcv_emp      , cn_rcv_rnf , cn_rcv_cal 
    220 #if defined key_cpl_carbon_cycle  
    221       NAMELIST/namsbc_cpl_co2/  cn_snd_co2, cn_rcv_co2 
    222 #endif 
     224      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos 
     225      !! 
     226      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   & 
     227         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,   & 
     228         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2 
    223229      !!--------------------------------------------------------------------- 
    224  
    225       IF( wrk_in_use(2, 3,4) ) THEN 
    226          CALL ctl_stop('sbc_cpl_init: requested workspace arrays unavailable')   ;   RETURN 
    227       ENDIF 
     230      ! 
     231      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_init') 
     232      ! 
     233      CALL wrk_alloc( jpi,jpj, zacs, zaos ) 
    228234 
    229235      ! ================================ ! 
    230236      !      Namelist informations       ! 
    231237      ! ================================ ! 
     238 
     239      ! default definitions 
     240      !                    !     description       !  multiple  !    vector   !      vector          ! vector ! 
     241      !                    !                       ! categories !  reference  !    orientation       ! grids  ! 
     242      ! send 
     243      sn_snd_temp   = FLD_C( 'weighted oce and ice',    'no'    ,     ''      ,         ''           ,   ''   )  
     244      sn_snd_alb    = FLD_C( 'weighted ice'        ,    'no'    ,     ''      ,         ''           ,   ''   )  
     245      sn_snd_thick  = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''           ,   ''   )  
     246      sn_snd_crt    = FLD_C( 'none'                ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'   )      
     247      sn_snd_co2    = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''           ,   ''   )      
     248      ! receive 
     249      sn_rcv_w10m   = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     250      sn_rcv_taumod = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     251      sn_rcv_tau    = FLD_C( 'oce only'            ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'  )   
     252      sn_rcv_dqnsdt = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     253      sn_rcv_qsr    = FLD_C( 'oce and ice'         ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     254      sn_rcv_qns    = FLD_C( 'oce and ice'         ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     255      sn_rcv_emp    = FLD_C( 'conservative'        ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     256      sn_rcv_rnf    = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     257      sn_rcv_cal    = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     258      sn_rcv_iceflx = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     259      sn_rcv_co2    = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    ) 
    232260 
    233261      REWIND( numnam )                    ! ... read namlist namsbc_cpl 
    … …  
    238266         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    239267         WRITE(numout,*)'~~~~~~~~~~~~' 
    240          WRITE(numout,*)'   received fields' 
    241          WRITE(numout,*)'       10m wind module                    cn_rcv_w10m        = ', cn_rcv_w10m  
    242          WRITE(numout,*)'       surface stress - nature            cn_rcv_tau_nature  = ', cn_rcv_tau_nature 
    243          WRITE(numout,*)'                      - referential       cn_rcv_tau_refere  = ', cn_rcv_tau_refere 
    244          WRITE(numout,*)'                      - orientation       cn_rcv_tau_orient  = ', cn_rcv_tau_orient 
    245          WRITE(numout,*)'                      - mesh              cn_rcv_tau_grid    = ', cn_rcv_tau_grid 
    246          WRITE(numout,*)'       non-solar heat flux sensitivity    cn_rcv_dqnsdt      = ', cn_rcv_dqnsdt 
    247          WRITE(numout,*)'       solar heat flux                    cn_rcv_qsr         = ', cn_rcv_qsr   
    248          WRITE(numout,*)'       non-solar heat flux                cn_rcv_qns         = ', cn_rcv_qns 
    249          WRITE(numout,*)'       freshwater budget                  cn_rcv_emp         = ', cn_rcv_emp 
    250          WRITE(numout,*)'       runoffs                            cn_rcv_rnf         = ', cn_rcv_rnf 
    251          WRITE(numout,*)'       calving                            cn_rcv_cal         = ', cn_rcv_cal  
    252          WRITE(numout,*)'       stress module                      cn_rcv_taumod      = ', cn_rcv_taumod 
    253          WRITE(numout,*)'   sent fields' 
    254          WRITE(numout,*)'       surface temperature                cn_snd_temperature = ', cn_snd_temperature 
    255          WRITE(numout,*)'       albedo                             cn_snd_albedo      = ', cn_snd_albedo 
    256          WRITE(numout,*)'       ice/snow thickness                 cn_snd_thickness   = ', cn_snd_thickness   
    257          WRITE(numout,*)'       surface current - nature           cn_snd_crt_nature  = ', cn_snd_crt_nature  
    258          WRITE(numout,*)'                       - referential      cn_snd_crt_refere  = ', cn_snd_crt_refere  
    259          WRITE(numout,*)'                       - orientation      cn_snd_crt_orient  = ', cn_snd_crt_orient 
    260          WRITE(numout,*)'                       - mesh             cn_snd_crt_grid    = ', cn_snd_crt_grid  
    261       ENDIF 
    262  
    263 #if defined key_cpl_carbon_cycle  
    264       REWIND( numnam )                    ! read namlist namsbc_cpl_co2 
    265       READ  ( numnam, namsbc_cpl_co2 ) 
    266       IF(lwp) THEN                        ! control print 
    267          WRITE(numout,*) 
    268          WRITE(numout,*)'sbc_cpl_init : namsbc_cpl_co2 namelist ' 
    269          WRITE(numout,*)'~~~~~~~~~~~~' 
    270          WRITE(numout,*)'   received fields' 
    271          WRITE(numout,*)'       atm co2                            cn_rcv_co2         = ', cn_rcv_co2 
    272          WRITE(numout,*)'   sent fields' 
    273          WRITE(numout,*)'      oce co2 flux                        cn_snd_co2         = ', cn_snd_co2 
    274           WRITE(numout,*) 
    275       ENDIF 
    276 #endif 
    277       ! save current & stress in an array and suppress possible blank in the name 
    278       cn_snd_crt(1) = TRIM( cn_snd_crt_nature )   ;   cn_snd_crt(2) = TRIM( cn_snd_crt_refere ) 
    279       cn_snd_crt(3) = TRIM( cn_snd_crt_orient )   ;   cn_snd_crt(4) = TRIM( cn_snd_crt_grid   ) 
    280       cn_rcv_tau(1) = TRIM( cn_rcv_tau_nature )   ;   cn_rcv_tau(2) = TRIM( cn_rcv_tau_refere ) 
    281       cn_rcv_tau(3) = TRIM( cn_rcv_tau_orient )   ;   cn_rcv_tau(4) = TRIM( cn_rcv_tau_grid   ) 
    282  
    283       !                                   ! allocate zdfric arrays 
     268         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
     269         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
     270         WRITE(numout,*)'      stress module                   = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' 
     271         WRITE(numout,*)'      surface stress                  = ', TRIM(sn_rcv_tau%cldes   ), ' (', TRIM(sn_rcv_tau%clcat   ), ')' 
     272         WRITE(numout,*)'                     - referential    = ', sn_rcv_tau%clvref 
     273         WRITE(numout,*)'                     - orientation    = ', sn_rcv_tau%clvor 
     274         WRITE(numout,*)'                     - mesh           = ', sn_rcv_tau%clvgrd 
     275         WRITE(numout,*)'      non-solar heat flux sensitivity = ', TRIM(sn_rcv_dqnsdt%cldes), ' (', TRIM(sn_rcv_dqnsdt%clcat), ')' 
     276         WRITE(numout,*)'      solar heat flux                 = ', TRIM(sn_rcv_qsr%cldes   ), ' (', TRIM(sn_rcv_qsr%clcat   ), ')' 
     277         WRITE(numout,*)'      non-solar heat flux             = ', TRIM(sn_rcv_qns%cldes   ), ' (', TRIM(sn_rcv_qns%clcat   ), ')' 
     278         WRITE(numout,*)'      freshwater budget               = ', TRIM(sn_rcv_emp%cldes   ), ' (', TRIM(sn_rcv_emp%clcat   ), ')' 
     279         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')' 
     280         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')' 
     281         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
     282         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
     283         WRITE(numout,*)'  sent fields (multiple ice categories)' 
     284         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
     285         WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')' 
     286         WRITE(numout,*)'      ice/snow thickness              = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' 
     287         WRITE(numout,*)'      surface current                 = ', TRIM(sn_snd_crt%cldes   ), ' (', TRIM(sn_snd_crt%clcat   ), ')' 
     288         WRITE(numout,*)'                      - referential   = ', sn_snd_crt%clvref  
     289         WRITE(numout,*)'                      - orientation   = ', sn_snd_crt%clvor 
     290         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
     291         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     292      ENDIF 
     293 
     294      !                                   ! allocate sbccpl arrays 
    284295      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    285296      
    … …  
    294305 
    295306      ! default definitions of srcv 
    296       srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1. 
     307      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1 
    297308 
    298309      !                                                      ! ------------------------- ! 
    … …  
    315326      !  
    316327      ! Vectors: change of sign at north fold ONLY if on the local grid 
    317       IF( TRIM( cn_rcv_tau(3) ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
     328      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
    318329       
    319330      !                                                           ! Set grid and action 
    320       SELECT CASE( TRIM( cn_rcv_tau(4) ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 
     331      SELECT CASE( TRIM( sn_rcv_tau%clvgrd ) )      !  'T', 'U,V', 'U,V,I', 'U,V,F', 'T,I', 'T,F', or 'T,U,V' 
    321332      CASE( 'T' )  
    322333         srcv(jpr_otx1:jpr_itz2)%clgrid  = 'T'        ! oce and ice components given at T-point 
    … …  
    364375         srcv(jpr_itx1:jpr_itz2)%laction = .TRUE.     ! receive ice components on grid 1 & 2 
    365376      CASE default    
    366          CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_tau(4)' ) 
     377         CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_tau%clvgrd' ) 
    367378      END SELECT 
    368379      ! 
    369       IF( TRIM( cn_rcv_tau(2) ) == 'spherical' )   &           ! spherical: 3rd component not received 
     380      IF( TRIM( sn_rcv_tau%clvref ) == 'spherical' )   &           ! spherical: 3rd component not received 
    370381         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.  
    371382      ! 
    372       IF( TRIM( cn_rcv_tau(1) ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used 
     383      IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used 
    373384         srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received 
    374385         srcv(jpr_itx1)%clgrid = 'U'                  ! ocean stress used after its transformation 
    … …  
    388399      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation 
    389400      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    390       SELECT CASE( TRIM( cn_rcv_emp ) ) 
     401      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    391402      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    392403      CASE( 'conservative'  )   ;   srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
    393404      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 
    394       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' ) 
     405      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 
    395406      END SELECT 
    396407 
    … …  
    398409      !                                                      !     Runoffs & Calving     !    
    399410      !                                                      ! ------------------------- ! 
    400       srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( cn_rcv_rnf ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
    401                                                  IF( TRIM( cn_rcv_rnf ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    402                                                  ELSE                                           ;   ln_rnf = .FALSE. 
    403                                                  ENDIF 
    404       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( cn_rcv_cal ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     411      srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
     412! This isn't right - really just want ln_rnf_emp changed 
     413!                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
     414!                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
     415!                                                 ENDIF 
     416      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    405417 
    406418      !                                                      ! ------------------------- ! 
    … …  
    410422      srcv(jpr_qnsice)%clname = 'O_QnsIce' 
    411423      srcv(jpr_qnsmix)%clname = 'O_QnsMix' 
    412       SELECT CASE( TRIM( cn_rcv_qns ) ) 
     424      SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 
    413425      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE. 
    414426      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
    415427      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qnsice, jpr_qnsoce/) )%laction = .TRUE. 
    416428      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qnsmix   )%laction = .TRUE.  
    417       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' ) 
     429      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 
    418430      END SELECT 
    419  
     431      IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
     432         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
    420433      !                                                      ! ------------------------- ! 
    421434      !                                                      !    solar radiation        !   Qsr 
    … …  
    424437      srcv(jpr_qsrice)%clname = 'O_QsrIce' 
    425438      srcv(jpr_qsrmix)%clname = 'O_QsrMix' 
    426       SELECT CASE( TRIM( cn_rcv_qsr ) ) 
     439      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 
    427440      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE. 
    428441      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
    429442      CASE( 'oce and ice'   )   ;   srcv( (/jpr_qsrice, jpr_qsroce/) )%laction = .TRUE. 
    430443      CASE( 'mixed oce-ice' )   ;   srcv(               jpr_qsrmix   )%laction = .TRUE.  
    431       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' ) 
     444      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 
    432445      END SELECT 
    433  
     446      IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
     447         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
    434448      !                                                      ! ------------------------- ! 
    435449      !                                                      !   non solar sensitivity   !   d(Qns)/d(T) 
    436450      !                                                      ! ------------------------- ! 
    437451      srcv(jpr_dqnsdt)%clname = 'O_dQnsdT'    
    438       IF( TRIM( cn_rcv_dqnsdt ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE. 
    439       ! 
    440       ! non solar sensitivity mandatory for ice model 
    441       IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. k_ice /= 0 ) & 
    442          CALL ctl_stop( 'sbc_cpl_init: cn_rcv_dqnsdt must be coupled in namsbc_cpl namelist' ) 
     452      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'coupled' )   srcv(jpr_dqnsdt)%laction = .TRUE. 
     453      ! 
     454      ! non solar sensitivity mandatory for LIM ice model 
     455      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 
     456         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    443457      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
    444       IF( TRIM( cn_rcv_dqnsdt ) == 'none' .AND. TRIM( cn_rcv_qns ) == 'mixed oce-ice' ) & 
    445          CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between cn_rcv_qns and cn_rcv_dqnsdt' ) 
     458      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 
     459         CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 
    446460      !                                                      ! ------------------------- ! 
    447461      !                                                      !    Ice Qsr penetration    !    
    … …  
    456470      !                                                      !      10m wind module      !    
    457471      !                                                      ! ------------------------- ! 
    458       srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(cn_rcv_w10m  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE.  
     472      srcv(jpr_w10m)%clname = 'O_Wind10'   ;   IF( TRIM(sn_rcv_w10m%cldes  ) == 'coupled' )   srcv(jpr_w10m)%laction = .TRUE.  
    459473      ! 
    460474      !                                                      ! ------------------------- ! 
    461475      !                                                      !   wind stress module      !    
    462476      !                                                      ! ------------------------- ! 
    463       srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(cn_rcv_taumod) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
     477      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
    464478      lhftau = srcv(jpr_taum)%laction 
    465479 
    466 #if defined key_cpl_carbon_cycle 
    467480      !                                                      ! ------------------------- ! 
    468481      !                                                      !      Atmospheric CO2      ! 
    469482      !                                                      ! ------------------------- ! 
    470       srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(cn_rcv_co2   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
    471 #endif 
    472       
     483      srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
     484      !                                                      ! ------------------------- ! 
     485      !                                                      !   topmelt and botmelt     !    
     486      !                                                      ! ------------------------- ! 
     487      srcv(jpr_topm )%clname = 'OTopMlt' 
     488      srcv(jpr_botm )%clname = 'OBotMlt' 
     489      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 
     490         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
     491            srcv(jpr_topm:jpr_botm)%nct = jpl 
     492         ELSE 
     493            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 
     494         ENDIF 
     495         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
     496      ENDIF 
     497 
     498      ! Allocate all parts of frcv used for received fields 
     499      DO jn = 1, jprcv 
     500         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     501      END DO 
     502      ! Allocate taum part of frcv which is used even when not received as coupling field 
     503      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 
     504 
    473505      ! ================================ ! 
    474506      !     Define the send interface    ! 
    475507      ! ================================ ! 
    476       ! for each field: define the OASIS name                           (srcv(:)%clname) 
    477       !                 define send or not from the namelist parameters (srcv(:)%laction) 
    478       !                 define the north fold type of lbc               (srcv(:)%nsgn) 
     508      ! for each field: define the OASIS name                           (ssnd(:)%clname) 
     509      !                 define send or not from the namelist parameters (ssnd(:)%laction) 
     510      !                 define the north fold type of lbc               (ssnd(:)%nsgn) 
    479511       
    480512      ! default definitions of nsnd 
    481       ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1. 
     513      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 
    482514          
    483515      !                                                      ! ------------------------- ! 
    … …  
    487519      ssnd(jps_tice)%clname = 'O_TepIce' 
    488520      ssnd(jps_tmix)%clname = 'O_TepMix' 
    489       SELECT CASE( TRIM( cn_snd_temperature ) ) 
     521      SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 
    490522      CASE( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE. 
    491       CASE( 'weighted oce and ice' )   ;   ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
     523      CASE( 'weighted oce and ice' ) 
     524         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
     525         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl 
    492526      CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix             )%laction = .TRUE. 
    493       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_temperature' ) 
     527      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    494528      END SELECT 
    495529      
    … …  
    499533      ssnd(jps_albice)%clname = 'O_AlbIce'  
    500534      ssnd(jps_albmix)%clname = 'O_AlbMix' 
    501       SELECT CASE( TRIM( cn_snd_albedo ) ) 
     535      SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 
    502536      CASE( 'none'          )       ! nothing to do 
    503537      CASE( 'weighted ice'  )   ;   ssnd(jps_albice)%laction = .TRUE. 
    504538      CASE( 'mixed oce-ice' )   ;   ssnd(jps_albmix)%laction = .TRUE. 
    505       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_albedo' ) 
     539      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 
    506540      END SELECT 
    507541      ! 
    … …  
    509543      !     1. sending mixed oce-ice albedo or 
    510544      !     2. receiving mixed oce-ice solar radiation  
    511       IF ( TRIM ( cn_snd_albedo ) == 'mixed oce-ice' .OR. TRIM ( cn_rcv_qsr ) == 'mixed oce-ice' ) THEN 
     545      IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 
    512546         CALL albedo_oce( zaos, zacs ) 
    513547         ! Due to lack of information on nebulosity : mean clear/overcast sky 
    … …  
    518552      !                                                      !  Ice fraction & Thickness !  
    519553      !                                                      ! ------------------------- ! 
    520       ssnd(jps_fice)%clname = 'OIceFrac'    
    521       ssnd(jps_hice)%clname = 'O_IceTck' 
    522       ssnd(jps_hsnw)%clname = 'O_SnwTck' 
    523       IF( k_ice /= 0 )   ssnd(jps_fice)%laction = .TRUE.       ! if ice treated in the ocean (even in climato case) 
    524       IF( TRIM( cn_snd_thickness ) == 'weighted ice and snow' )   ssnd( (/jps_hice, jps_hsnw/) )%laction = .TRUE. 
    525           
     554      ssnd(jps_fice)%clname = 'OIceFrc' 
     555      ssnd(jps_hice)%clname = 'OIceTck' 
     556      ssnd(jps_hsnw)%clname = 'OSnwTck' 
     557      IF( k_ice /= 0 ) THEN 
     558         ssnd(jps_fice)%laction = .TRUE.                  ! if ice treated in the ocean (even in climato case) 
     559! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 
     560         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
     561      ENDIF 
     562 
     563      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
     564      CASE ( 'ice and snow' )  
     565         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
     566         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
     567            ssnd(jps_hice:jps_hsnw)%nct = jpl 
     568         ELSE 
     569            IF ( jpl > 1 ) THEN 
     570               CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
     571            ENDIF 
     572         ENDIF 
     573      CASE ( 'weighted ice and snow' )  
     574         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
     575         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl 
     576      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 
     577      END SELECT 
     578 
    526579      !                                                      ! ------------------------- ! 
    527580      !                                                      !      Surface current      ! 
    … …  
    534587      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1.   ! vectors: change of the sign at the north fold 
    535588 
    536       IF( cn_snd_crt(4) /= 'T' )   CALL ctl_stop( 'cn_snd_crt(4) must be equal to T' ) 
    537       ssnd(jps_ocx1:jps_ivz1)%clgrid  = 'T'      ! all oce and ice components on the same unique grid 
    538  
     589      IF( sn_snd_crt%clvgrd == 'U,V' ) THEN 
     590         ssnd(jps_ocx1)%clgrid = 'U' ; ssnd(jps_ocy1)%clgrid = 'V' 
     591      ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN   
     592         CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 
     593         ssnd(jps_ocx1:jps_ivz1)%clgrid  = 'T'      ! all oce and ice components on the same unique grid 
     594      ENDIF 
    539595      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send 
    540       IF( TRIM( cn_snd_crt(2) ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.  
    541       SELECT CASE( TRIM( cn_snd_crt(1) ) ) 
     596      IF( TRIM( sn_snd_crt%clvref ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.  
     597      IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) ssnd(jps_ocx1:jps_ivz1)%nsgn = 1. 
     598      SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    542599      CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE. 
    543600      CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
    544601      CASE( 'weighted oce and ice' )   !   nothing to do 
    545602      CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
    546       CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_snd_crt(1)' ) 
     603      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_crt%cldes' ) 
    547604      END SELECT 
    548605 
    549 #if defined key_cpl_carbon_cycle 
    550606      !                                                      ! ------------------------- ! 
    551607      !                                                      !          CO2 flux         ! 
    552608      !                                                      ! ------------------------- ! 
    553       ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(cn_snd_co2) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
    554 #endif 
     609      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
    555610      ! 
    556611      ! ================================ ! 
    … …  
    563618         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    564619 
    565       IF( wrk_not_released(2, 3,4) )   CALL ctl_stop('sbc_cpl_init: failed to release workspace arrays') 
     620      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
     621      ! 
     622      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_init') 
    566623      ! 
    567624   END SUBROUTINE sbc_cpl_init 
    … …  
    610667      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case) 
    611668      !!---------------------------------------------------------------------- 
    612       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    613       USE wrk_nemo, ONLY:   ztx => wrk_2d_1 , zty => wrk_2d_2 
    614       !! 
    615669      INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    616670      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    … …  
    625679      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    626680      REAL(wp) ::   zzx, zzy               ! temporary variables 
     681      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
    627682      !!---------------------------------------------------------------------- 
    628  
    629       IF( wrk_in_use(2, 1,2) ) THEN 
    630          CALL ctl_stop('sbc_cpl_rcv: requested workspace arrays unavailable')   ;   RETURN 
    631       ENDIF 
     683      ! 
     684      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
     685      ! 
     686      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    632687 
    633688      IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation 
    … …  
    636691      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    637692      DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    638          IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(:,:,jn), nrcvinfo(jn) ) 
     693         IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 
    639694      END DO 
    640695 
    … …  
    642697      IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  ! 
    643698         !                                                   ! ========================= ! 
    644          ! define frcv(:,:,jpr_otx1) and frcv(:,:,jpr_oty1): stress at U/V point along model grid 
     699         ! define frcv(jpr_otx1)%z3(:,:,1) and frcv(jpr_oty1)%z3(:,:,1): stress at U/V point along model grid 
    645700         ! => need to be done only when we receive the field 
    646701         IF(  nrcvinfo(jpr_otx1) == OASIS_Rcv ) THEN 
    647702            ! 
    648             IF( TRIM( cn_rcv_tau(2) ) == 'cartesian' ) THEN            ! 2 components on the sphere 
     703            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    649704               !                                                       ! (cartesian to spherical -> 3 to 2 components) 
    650705               ! 
    651                CALL geo2oce( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), frcv(:,:,jpr_otz1),   & 
     706               CALL geo2oce( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), frcv(jpr_otz1)%z3(:,:,1),   & 
    652707                  &          srcv(jpr_otx1)%clgrid, ztx, zty ) 
    653                frcv(:,:,jpr_otx1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
    654                frcv(:,:,jpr_oty1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
     708               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
     709               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
    655710               ! 
    656711               IF( srcv(jpr_otx2)%laction ) THEN 
    657                   CALL geo2oce( frcv(:,:,jpr_otx2), frcv(:,:,jpr_oty2), frcv(:,:,jpr_otz2),   & 
     712                  CALL geo2oce( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), frcv(jpr_otz2)%z3(:,:,1),   & 
    658713                     &          srcv(jpr_otx2)%clgrid, ztx, zty ) 
    659                   frcv(:,:,jpr_otx2) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
    660                   frcv(:,:,jpr_oty2) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
     714                  frcv(jpr_otx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
     715                  frcv(jpr_oty2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
    661716               ENDIF 
    662717               ! 
    663718            ENDIF 
    664719            ! 
    665             IF( TRIM( cn_rcv_tau(3) ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
     720            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    666721               !                                                       ! (geographical to local grid -> rotate the components) 
    667                CALL rot_rep( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    668                frcv(:,:,jpr_otx1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     722               CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
     723               frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    669724               IF( srcv(jpr_otx2)%laction ) THEN 
    670                   CALL rot_rep( frcv(:,:,jpr_otx2), frcv(:,:,jpr_oty2), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
    671                ELSE 
    672                   CALL rot_rep( frcv(:,:,jpr_otx1), frcv(:,:,jpr_oty1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     725                  CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     726               ELSE   
     727                  CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
    673728               ENDIF 
    674                frcv(:,:,jpr_oty1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
     729               frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    675730            ENDIF 
    676731            !                               
    … …  
    678733               DO jj = 2, jpjm1                                          ! T ==> (U,V) 
    679734                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    680                      frcv(ji,jj,jpr_otx1) = 0.5 * ( frcv(ji+1,jj  ,jpr_otx1) + frcv(ji,jj,jpr_otx1) ) 
    681                      frcv(ji,jj,jpr_oty1) = 0.5 * ( frcv(ji  ,jj+1,jpr_oty1) + frcv(ji,jj,jpr_oty1) ) 
     735                     frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 
     736                     frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji  ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 
    682737                  END DO 
    683738               END DO 
    684                CALL lbc_lnk( frcv(:,:,jpr_otx1), 'U',  -1. )   ;   CALL lbc_lnk( frcv(:,:,jpr_oty1), 'V',  -1. ) 
     739               CALL lbc_lnk( frcv(jpr_otx1)%z3(:,:,1), 'U',  -1. )   ;   CALL lbc_lnk( frcv(jpr_oty1)%z3(:,:,1), 'V',  -1. ) 
    685740            ENDIF 
    686741            llnewtx = .TRUE. 
    … …  
    691746      ELSE                                                   !   No dynamical coupling   ! 
    692747         !                                                   ! ========================= ! 
    693          frcv(:,:,jpr_otx1) = 0.e0                               ! here simply set to zero  
    694          frcv(:,:,jpr_oty1) = 0.e0                               ! an external read in a file can be added instead 
     748         frcv(jpr_otx1)%z3(:,:,1) = 0.e0                               ! here simply set to zero  
     749         frcv(jpr_oty1)%z3(:,:,1) = 0.e0                               ! an external read in a file can be added instead 
    695750         llnewtx = .TRUE. 
    696751         ! 
    … …  
    708763!CDIR NOVERRCHK 
    709764               DO ji = fs_2, fs_jpim1   ! vect. opt. 
    710                   zzx = frcv(ji-1,jj  ,jpr_otx1) + frcv(ji,jj,jpr_otx1)  
    711                   zzy = frcv(ji  ,jj-1,jpr_oty1) + frcv(ji,jj,jpr_oty1)  
    712                   frcv(ji,jj,jpr_taum) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 
     765                  zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 
     766                  zzy = frcv(jpr_oty1)%z3(ji  ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 
     767                  frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 
    713768               END DO 
    714769            END DO 
    715             CALL lbc_lnk( frcv(:,:,jpr_taum), 'T', 1. ) 
     770            CALL lbc_lnk( frcv(jpr_taum)%z3(:,:,1), 'T', 1. ) 
    716771            llnewtau = .TRUE. 
    717772         ELSE 
    … …  
    722777         ! Stress module can be negative when received (interpolation problem) 
    723778         IF( llnewtau ) THEN  
    724             DO jj = 1, jpj 
    725                DO ji = 1, jpi  
    726                   frcv(ji,jj,jpr_taum) = MAX( 0.0e0, frcv(ji,jj,jpr_taum) ) 
    727                END DO 
    728             END DO 
     779            frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) ) 
    729780         ENDIF 
    730781      ENDIF 
    … …  
    742793!CDIR NOVERRCHK 
    743794               DO ji = 1, jpi  
    744                   frcv(ji,jj,jpr_w10m) = SQRT( frcv(ji,jj,jpr_taum) * zcoef ) 
     795                  wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    745796               END DO 
    746797            END DO 
    747798         ENDIF 
    748       ENDIF 
    749  
    750       ! u(v)tau and taum will be modified by ice model (wndm will be changed by PISCES) 
     799      ELSE 
     800         IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
     801      ENDIF 
     802 
     803      ! u(v)tau and taum will be modified by ice model 
    751804      ! -> need to be reset before each call of the ice/fsbc       
    752805      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    753806         ! 
    754          utau(:,:) = frcv(:,:,jpr_otx1)                    
    755          vtau(:,:) = frcv(:,:,jpr_oty1) 
    756          taum(:,:) = frcv(:,:,jpr_taum) 
    757          wndm(:,:) = frcv(:,:,jpr_w10m) 
     807         utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
     808         vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
     809         taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
    758810         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    759811         !   
    760812      ENDIF 
     813 
     814#if defined key_cpl_carbon_cycle 
     815      !                                                              ! atmosph. CO2 (ppm) 
     816      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
     817#endif 
     818 
    761819      !                                                      ! ========================= ! 
    762820      IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case) 
    … …  
    764822         ! 
    765823         !                                                       ! non solar heat flux over the ocean (qns) 
    766          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(:,:,jpr_qnsoce) 
    767          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(:,:,jpr_qnsmix)   
     824         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     825         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    768826         ! add the latent heat of solid precip. melting 
    769          IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * lfus               
     827         IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus               
    770828 
    771829         !                                                       ! solar flux over the ocean          (qsr) 
    772          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce)  
    773          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(:,:,jpr_qsrmix) 
     830         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     831         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    774832         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
    775833         ! 
    776834         !                                                       ! total freshwater fluxes over the ocean (emp, emps) 
    777          SELECT CASE( TRIM( cn_rcv_emp ) )                                    ! evaporation - precipitation 
     835         SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    778836         CASE( 'conservative' ) 
    779             emp(:,:) = frcv(:,:,jpr_tevp) - ( frcv(:,:,jpr_rain) + frcv(:,:,jpr_snow) ) 
     837            emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
    780838         CASE( 'oce only', 'oce and ice' ) 
    781             emp(:,:) = frcv(:,:,jpr_oemp) 
     839            emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
    782840         CASE default 
    783             CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of cn_rcv_emp' ) 
     841            CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
    784842         END SELECT 
    785843         ! 
    786844         !                                                        ! runoffs and calving (added in emp) 
    787          IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(:,:,jpr_rnf)         
    788          IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(:,:,jpr_cal) 
     845         IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
     846         IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    789847         ! 
    790848!!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    791849!!gm                                       at least should be optional... 
    792 !!         IF( TRIM( cn_rcv_rnf ) == 'coupled' ) THEN     ! add to the total freshwater budget 
     850!!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    793851!!            ! remove negative runoff 
    794 !!            zcumulpos = SUM( MAX( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    795 !!            zcumulneg = SUM( MIN( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
     852!!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
     853!!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    796854!!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    797855!!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    798856!!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points 
    799857!!               zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    800 !!               frcv(:,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg 
     858!!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    801859!!            ENDIF      
    802860!!            ! add runoff to e-p  
    803 !!            emp(:,:) = emp(:,:) - frcv(:,:,jpr_rnf) 
     861!!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    804862!!         ENDIF 
    805863!!gm  end of internal cooking 
    … …  
    807865         emps(:,:) = emp(:,:)                                        ! concentration/dilution = emp 
    808866   
    809          !                                                           ! 10 m wind speed 
    810          IF( srcv(jpr_w10m)%laction )   wndm(:,:) = frcv(:,:,jpr_w10m) 
    811          ! 
    812 #if defined  key_cpl_carbon_cycle 
    813          !                                                              ! atmosph. CO2 (ppm) 
    814          IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(:,:,jpr_co2) 
    815 #endif 
    816  
    817       ENDIF 
    818       ! 
    819       IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('sbc_cpl_rcv: failed to release workspace arrays') 
     867      ENDIF 
     868      ! 
     869      CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
     870      ! 
     871      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
    820872      ! 
    821873   END SUBROUTINE sbc_cpl_rcv 
    … …  
    855907      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point 
    856908      !!---------------------------------------------------------------------- 
    857       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    858       USE wrk_nemo, ONLY:   ztx => wrk_2d_1 , zty => wrk_2d_2 
    859       !! 
    860909      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    861910      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    … …  
    863912      INTEGER ::   ji, jj                          ! dummy loop indices 
    864913      INTEGER ::   itx                             ! index of taux over ice 
     914      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
    865915      !!---------------------------------------------------------------------- 
    866  
    867       IF( wrk_in_use(2, 1,2) ) THEN 
    868          CALL ctl_stop('sbc_cpl_ice_tau: requested workspace arrays unavailable')   ;   RETURN 
    869       ENDIF 
     916      ! 
     917      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_tau') 
     918      ! 
     919      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    870920 
    871921      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    … …  
    880930            !                                                   ! ======================= ! 
    881931            !   
    882             IF( TRIM( cn_rcv_tau(2) ) == 'cartesian' ) THEN            ! 2 components on the sphere 
     932            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
    883933               !                                                       ! (cartesian to spherical -> 3 to 2 components) 
    884                CALL geo2oce( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), frcv(:,:,jpr_itz1),   & 
     934               CALL geo2oce(  frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), frcv(jpr_itz1)%z3(:,:,1),   & 
    885935                  &          srcv(jpr_itx1)%clgrid, ztx, zty ) 
    886                frcv(:,:,jpr_itx1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
    887                frcv(:,:,jpr_itx1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
     936               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 1st grid 
     937               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 1st grid 
    888938               ! 
    889939               IF( srcv(jpr_itx2)%laction ) THEN 
    890                   CALL geo2oce( frcv(:,:,jpr_itx2), frcv(:,:,jpr_ity2), frcv(:,:,jpr_itz2),   & 
     940                  CALL geo2oce( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), frcv(jpr_itz2)%z3(:,:,1),   & 
    891941                     &          srcv(jpr_itx2)%clgrid, ztx, zty ) 
    892                   frcv(:,:,jpr_itx2) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
    893                   frcv(:,:,jpr_ity2) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
     942                  frcv(jpr_itx2)%z3(:,:,1) = ztx(:,:)   ! overwrite 1st comp. on the 2nd grid 
     943                  frcv(jpr_ity2)%z3(:,:,1) = zty(:,:)   ! overwrite 2nd comp. on the 2nd grid 
    894944               ENDIF 
    895945               ! 
    896946            ENDIF 
    897947            ! 
    898             IF( TRIM( cn_rcv_tau(3) ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
     948            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    899949               !                                                       ! (geographical to local grid -> rotate the components) 
    900                CALL rot_rep( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )    
    901                frcv(:,:,jpr_itx1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     950               CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->i', ztx )    
     951               frcv(jpr_itx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    902952               IF( srcv(jpr_itx2)%laction ) THEN 
    903                   CALL rot_rep( frcv(:,:,jpr_itx2), frcv(:,:,jpr_ity2), srcv(jpr_itx2)%clgrid, 'en->j', zty )    
     953                  CALL rot_rep( frcv(jpr_itx2)%z3(:,:,1), frcv(jpr_ity2)%z3(:,:,1), srcv(jpr_itx2)%clgrid, 'en->j', zty )    
    904954               ELSE 
    905                   CALL rot_rep( frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1), srcv(jpr_itx1)%clgrid, 'en->j', zty )   
     955                  CALL rot_rep( frcv(jpr_itx1)%z3(:,:,1), frcv(jpr_ity1)%z3(:,:,1), srcv(jpr_itx1)%clgrid, 'en->j', zty )   
    906956               ENDIF 
    907                frcv(:,:,jpr_ity1) = zty(:,:)      ! overwrite 2nd component on the 1st grid 
     957               frcv(jpr_ity1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 1st grid 
    908958            ENDIF 
    909959            !                                                   ! ======================= ! 
    910960         ELSE                                                   !     use ocean stress    ! 
    911961            !                                                   ! ======================= ! 
    912             frcv(:,:,jpr_itx1) = frcv(:,:,jpr_otx1) 
    913             frcv(:,:,jpr_ity1) = frcv(:,:,jpr_oty1) 
     962            frcv(jpr_itx1)%z3(:,:,1) = frcv(jpr_otx1)%z3(:,:,1) 
     963            frcv(jpr_ity1)%z3(:,:,1) = frcv(jpr_oty1)%z3(:,:,1) 
    914964            ! 
    915965         ENDIF 
    … …  
    934984               DO jj = 2, jpjm1                                   ! (U,V) ==> I 
    935985                  DO ji = 2, jpim1   ! NO vector opt. 
    936                      p_taui(ji,jj) = 0.5 * ( frcv(ji-1,jj  ,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) ) 
    937                      p_tauj(ji,jj) = 0.5 * ( frcv(ji  ,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) ) 
     986                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji-1,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) ) 
     987                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 
    938988                  END DO 
    939989               END DO 
    … …  
    941991               DO jj = 2, jpjm1                                   ! F ==> I 
    942992                  DO ji = 2, jpim1   ! NO vector opt. 
    943                      p_taui(ji,jj) = frcv(ji-1,jj-1,jpr_itx1)  
    944                      p_tauj(ji,jj) = frcv(ji-1,jj-1,jpr_ity1)   
     993                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji-1,jj-1,1) 
     994                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji-1,jj-1,1) 
    945995                  END DO 
    946996               END DO 
    … …  
    948998               DO jj = 2, jpjm1                                   ! T ==> I 
    949999                  DO ji = 2, jpim1   ! NO vector opt. 
    950                      p_taui(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_itx1) + frcv(ji-1,jj  ,jpr_itx1)   & 
    951                         &                   + frcv(ji,jj-1,jpr_itx1) + frcv(ji-1,jj-1,jpr_itx1) )  
    952                      p_tauj(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_ity1) + frcv(ji-1,jj  ,jpr_ity1)   & 
    953                         &                   + frcv(ji,jj-1,jpr_ity1) + frcv(ji-1,jj-1,jpr_ity1) ) 
     1000                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji-1,jj  ,1)   & 
     1001                        &                   + frcv(jpr_itx1)%z3(ji,jj-1,1) + frcv(jpr_itx1)%z3(ji-1,jj-1,1) )  
     1002                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1)   & 
     1003                        &                   + frcv(jpr_oty1)%z3(ji,jj-1,1) + frcv(jpr_ity1)%z3(ji-1,jj-1,1) ) 
    9541004                  END DO 
    9551005               END DO 
    9561006            CASE( 'I' ) 
    957                p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! I ==> I 
    958                p_tauj(:,:) = frcv(:,:,jpr_ity1) 
     1007               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! I ==> I 
     1008               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    9591009            END SELECT 
    9601010            IF( srcv(jpr_itx1)%clgrid /= 'I' ) THEN  
    … …  
    9671017               DO jj = 2, jpjm1                                   ! (U,V) ==> F 
    9681018                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    969                      p_taui(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_itx1) + frcv(ji  ,jj+1,jpr_itx1) ) 
    970                      p_tauj(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_ity1) + frcv(ji+1,jj  ,jpr_ity1) ) 
     1019                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj+1,1) ) 
     1020                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1) ) 
    9711021                  END DO 
    9721022               END DO 
    … …  
    9741024               DO jj = 2, jpjm1                                   ! I ==> F 
    9751025                  DO ji = 2, jpim1   ! NO vector opt. 
    976                      p_taui(ji,jj) = frcv(ji+1,jj+1,jpr_itx1)  
    977                      p_tauj(ji,jj) = frcv(ji+1,jj+1,jpr_ity1)   
     1026                     p_taui(ji,jj) = frcv(jpr_itx1)%z3(ji+1,jj+1,1) 
     1027                     p_tauj(ji,jj) = frcv(jpr_ity1)%z3(ji+1,jj+1,1) 
    9781028                  END DO 
    9791029               END DO 
    … …  
    9811031               DO jj = 2, jpjm1                                   ! T ==> F 
    9821032                  DO ji = 2, jpim1   ! NO vector opt. 
    983                      p_taui(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_itx1) + frcv(ji+1,jj  ,jpr_itx1)   & 
    984                         &                   + frcv(ji,jj+1,jpr_itx1) + frcv(ji+1,jj+1,jpr_itx1) )  
    985                      p_tauj(ji,jj) = 0.25 * ( frcv(ji,jj  ,jpr_ity1) + frcv(ji+1,jj  ,jpr_ity1)   & 
    986                         &                   + frcv(ji,jj+1,jpr_ity1) + frcv(ji+1,jj+1,jpr_ity1) ) 
     1033                     p_taui(ji,jj) = 0.25 * ( frcv(jpr_itx1)%z3(ji,jj  ,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1)   & 
     1034                        &                   + frcv(jpr_itx1)%z3(ji,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj+1,1) )  
     1035                     p_tauj(ji,jj) = 0.25 * ( frcv(jpr_ity1)%z3(ji,jj  ,1) + frcv(jpr_ity1)%z3(ji+1,jj  ,1)   & 
     1036                        &                   + frcv(jpr_ity1)%z3(ji,jj+1,1) + frcv(jpr_ity1)%z3(ji+1,jj+1,1) ) 
    9871037                  END DO 
    9881038               END DO 
    9891039            CASE( 'F' ) 
    990                p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! F ==> F 
    991                p_tauj(:,:) = frcv(:,:,jpr_ity1) 
     1040               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! F ==> F 
     1041               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    9921042            END SELECT 
    9931043            IF( srcv(jpr_itx1)%clgrid /= 'F' ) THEN  
    … …  
    9981048            SELECT CASE ( srcv(jpr_itx1)%clgrid ) 
    9991049            CASE( 'U' ) 
    1000                p_taui(:,:) = frcv(:,:,jpr_itx1)                   ! (U,V) ==> (U,V) 
    1001                p_tauj(:,:) = frcv(:,:,jpr_ity1) 
     1050               p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V) 
     1051               p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    10021052            CASE( 'F' ) 
    10031053               DO jj = 2, jpjm1                                   ! F ==> (U,V) 
    10041054                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1005                      p_taui(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_itx1) + frcv(ji  ,jj-1,jpr_itx1) ) 
    1006                      p_tauj(ji,jj) = 0.5 * ( frcv(ji,jj,jpr_ity1) + frcv(ji-1,jj  ,jpr_ity1) ) 
     1055                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) ) 
     1056                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(jj,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) ) 
    10071057                  END DO 
    10081058               END DO 
    … …  
    10101060               DO jj = 2, jpjm1                                   ! T ==> (U,V) 
    10111061                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1012                      p_taui(ji,jj) = 0.5 * ( frcv(ji+1,jj  ,jpr_itx1) + frcv(ji,jj,jpr_itx1) ) 
    1013                      p_tauj(ji,jj) = 0.5 * ( frcv(ji  ,jj+1,jpr_ity1) + frcv(ji,jj,jpr_ity1) ) 
     1062                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
     1063                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
    10141064                  END DO 
    10151065               END DO 
    … …  
    10171067               DO jj = 2, jpjm1                                   ! I ==> (U,V) 
    10181068                  DO ji = 2, jpim1   ! NO vector opt. 
    1019                      p_taui(ji,jj) = 0.5 * ( frcv(ji+1,jj+1,jpr_itx1) + frcv(ji+1,jj  ,jpr_itx1) ) 
    1020                      p_tauj(ji,jj) = 0.5 * ( frcv(ji+1,jj+1,jpr_ity1) + frcv(ji  ,jj+1,jpr_ity1) ) 
     1069                     p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) ) 
     1070                     p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) ) 
    10211071                  END DO 
    10221072               END DO 
    … …  
    10271077         END SELECT 
    10281078 
    1029          !!gm Should be useless as sbc_cpl_ice_tau only called at coupled frequency 
    1030          ! The receive stress are transformed such that in all case frcv(:,:,jpr_itx1), frcv(:,:,jpr_ity1) 
    1031          ! become the i-component and j-component of the stress at the right grid point  
    1032          !!gm  frcv(:,:,jpr_itx1) = p_taui(:,:) 
    1033          !!gm  frcv(:,:,jpr_ity1) = p_tauj(:,:) 
    1034          !!gm 
    10351079      ENDIF 
    10361080      !    
    1037       IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('sbc_cpl_ice_tau: failed to release workspace arrays') 
     1081      CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
     1082      ! 
     1083      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_tau') 
    10381084      ! 
    10391085   END SUBROUTINE sbc_cpl_ice_tau 
    10401086    
    10411087 
    1042    SUBROUTINE sbc_cpl_ice_flx( p_frld  ,                                  & 
    1043       &                        pqns_tot, pqns_ice, pqsr_tot , pqsr_ice,   & 
    1044       &                        pemp_tot, pemp_ice, pdqns_ice, psprecip,   & 
    1045       &                        palbi   , psst    , pist                 ) 
     1088   SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
    10461089      !!---------------------------------------------------------------------- 
    1047       !!             ***  ROUTINE sbc_cpl_ice_flx_rcv  *** 
     1090      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
    10481091      !! 
    10491092      !! ** Purpose :   provide the heat and freshwater fluxes of the  
    … …  
    10661109      !!             the atmosphere 
    10671110      !! 
    1068       !!             N.B. - fields over sea-ice are passed in argument so that 
    1069       !!                 the module can be compile without sea-ice. 
    10701111      !!                  - the fluxes have been separated from the stress as 
    10711112      !!                 (a) they are updated at each ice time step compare to 
    … …  
    10781119      !! 
    10791120      !! ** Action  :   update at each nf_ice time step: 
    1080       !!                   pqns_tot, pqsr_tot  non-solar and solar total heat fluxes 
    1081       !!                   pqns_ice, pqsr_ice  non-solar and solar heat fluxes over the ice 
    1082       !!                   pemp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 
    1083       !!                   pemp_ice            ice sublimation - solid precipitation over the ice 
    1084       !!                   pdqns_ice           d(non-solar heat flux)/d(Temperature) over the ice 
     1121      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes 
     1122      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice 
     1123      !!                   emp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 
     1124      !!                   emp_ice            ice sublimation - solid precipitation over the ice 
     1125      !!                   dqns_ice           d(non-solar heat flux)/d(Temperature) over the ice 
    10851126      !!                   sprecip             solid precipitation over the ocean   
    10861127      !!---------------------------------------------------------------------- 
    1087       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1088       USE wrk_nemo, ONLY:   zcptn  => wrk_2d_1   ! rcp * tn(:,:,1) 
    1089       USE wrk_nemo, ONLY:   ztmp   => wrk_2d_2   ! temporary array 
    1090       USE wrk_nemo, ONLY:   zsnow  => wrk_2d_3   ! snow precipitation  
    1091       USE wrk_nemo, ONLY:   zicefr => wrk_3d_4   ! ice fraction  
    1092       !! 
    1093       REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
    1094       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
    1095       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
    1096       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
    1097       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
    1098       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget        [Kg/m2/s] 
    1099       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! solid freshwater budget over ice   [Kg/m2/s] 
    1100       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! Net solid precipitation (=emp_ice) [Kg/m2/s] 
    1101       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
     1128      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11021129      ! optional arguments, used only in 'mixed oce-ice' case 
    11031130      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
    11041131      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
    11051132      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1106       !! 
    1107       INTEGER ::   ji, jj           ! dummy loop indices 
    1108       INTEGER ::   isec, info       ! temporary integer 
    1109       REAL(wp)::   zcoef, ztsurf    ! temporary scalar 
     1133      ! 
     1134      INTEGER ::   jl   ! dummy loop index 
     1135      REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr 
    11101136      !!---------------------------------------------------------------------- 
    1111  
    1112       IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 4) ) THEN 
    1113          CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable')   ;   RETURN 
    1114       ENDIF 
    1115  
    1116       zicefr(:,:,1) = 1.- p_frld(:,:,1) 
    1117       IF( lk_diaar5 )   zcptn(:,:) = rcp * tn(:,:,1) 
     1137      ! 
     1138      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
     1139      ! 
     1140      CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     1141 
     1142      zicefr(:,:) = 1.- p_frld(:,:) 
     1143      IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 
    11181144      ! 
    11191145      !                                                      ! ========================= ! 
    … …  
    11241150      !                                                           ! solid precipitation  - sublimation       (emp_ice) 
    11251151      !                                                           ! solid Precipitation                      (sprecip) 
    1126       SELECT CASE( TRIM( cn_rcv_emp ) ) 
     1152      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    11271153      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1128          pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) - frcv(:,:,jpr_snow) 
    1129          pemp_ice(:,:) = frcv(:,:,jpr_ievp) - frcv(:,:,jpr_snow) 
    1130          zsnow   (:,:) = frcv(:,:,jpr_snow) 
    1131                            CALL iom_put( 'rain'         , frcv(:,:,jpr_rain)              )   ! liquid precipitation  
    1132          IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(:,:,jpr_rain) * zcptn(:,:) )   ! heat flux from liq. precip.  
    1133          ztmp(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_ievp) * zicefr(:,:,1) 
     1154         sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
     1155         tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
     1156         emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
     1157         emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1158                           CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
     1159         IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
     1160         ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    11341161                           CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average) 
    11351162         IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave) 
    1136       CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 
    1137          pemp_tot(:,:) = p_frld(:,:,1) * frcv(:,:,jpr_oemp) + zicefr(:,:,1) * frcv(:,:,jpr_sbpr)  
    1138          pemp_ice(:,:) = frcv(:,:,jpr_semp) 
    1139          zsnow   (:,:) = - frcv(:,:,jpr_semp) + frcv(:,:,jpr_ievp) 
     1163      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
     1164         emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1165         emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1166         sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
    11401167      END SELECT 
    1141       psprecip(:,:) = - pemp_ice(:,:) 
    1142       CALL iom_put( 'snowpre'    , zsnow                               )   ! Snow 
    1143       CALL iom_put( 'snow_ao_cea', zsnow(:,:         ) * p_frld(:,:,1) )   ! Snow        over ice-free ocean  (cell average) 
    1144       CALL iom_put( 'snow_ai_cea', zsnow(:,:         ) * zicefr(:,:,1) )   ! Snow        over sea-ice         (cell average) 
    1145       CALL iom_put( 'subl_ai_cea', frcv (:,:,jpr_ievp) * zicefr(:,:,1) )   ! Sublimation over sea-ice         (cell average) 
     1168 
     1169      CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
     1170      CALL iom_put( 'snow_ao_cea', sprecip(:,:         ) * p_frld(:,:)    )   ! Snow        over ice-free ocean  (cell average) 
     1171      CALL iom_put( 'snow_ai_cea', sprecip(:,:         ) * zicefr(:,:)    )   ! Snow        over sea-ice         (cell average) 
     1172      CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    11461173      !    
    11471174      !                                                           ! runoffs and calving (put in emp_tot) 
    11481175      IF( srcv(jpr_rnf)%laction ) THEN  
    1149          pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf) 
    1150                            CALL iom_put( 'runoffs'      , frcv(:,:,jpr_rnf )              )   ! rivers 
    1151          IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(:,:,jpr_rnf ) * zcptn(:,:) )   ! heat flux from rivers 
     1176         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
     1177                           CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
     1178         IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    11521179      ENDIF 
    11531180      IF( srcv(jpr_cal)%laction ) THEN  
    1154          pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_cal) 
    1155          CALL iom_put( 'calving', frcv(:,:,jpr_cal) ) 
     1181         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1182         CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
    11561183      ENDIF 
    11571184      ! 
    … …  
    11591186!!gm                                       at least should be optional... 
    11601187!!       ! remove negative runoff                            ! sum over the global domain 
    1161 !!       zcumulpos = SUM( MAX( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1162 !!       zcumulneg = SUM( MIN( frcv(:,:,jpr_rnf), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
     1188!!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
     1189!!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    11631190!!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    11641191!!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    11651192!!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points 
    11661193!!          zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    1167 !!          frcv(:,:,jpr_rnf) = MAX( frcv(:,:,jpr_rnf), 0.e0 ) * zcumulneg 
     1194!!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    11681195!!       ENDIF      
    1169 !!       pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf)   ! add runoff to e-p  
     1196!!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
    11701197!! 
    11711198!!gm  end of internal cooking 
    11721199 
    1173  
    11741200      !                                                      ! ========================= ! 
    1175       SELECT CASE( TRIM( cn_rcv_qns ) )                      !   non solar heat fluxes   !   (qns) 
     1201      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns) 
    11761202      !                                                      ! ========================= ! 
     1203      CASE( 'oce only' )                                     ! the required field is directly provided 
     1204         qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    11771205      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1178          pqns_tot(:,:  ) = frcv(:,:,jpr_qnsmix) 
    1179          pqns_ice(:,:,1) = frcv(:,:,jpr_qnsice) 
     1206         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1207         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1208            qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     1209         ELSE 
     1210            ! Set all category values equal for the moment 
     1211            DO jl=1,jpl 
     1212               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1213            ENDDO 
     1214         ENDIF 
    11801215      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1181          pqns_tot(:,:  ) =  p_frld(:,:,1) * frcv(:,:,jpr_qnsoce) + zicefr(:,:,1) * frcv(:,:,jpr_qnsice) 
    1182          pqns_ice(:,:,1) =  frcv(:,:,jpr_qnsice) 
     1216         qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1217         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1218            DO jl=1,jpl 
     1219               qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1220               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     1221            ENDDO 
     1222         ELSE 
     1223            DO jl=1,jpl 
     1224               qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1225               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1226            ENDDO 
     1227         ENDIF 
    11831228      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    1184          pqns_tot(:,:  ) = frcv(:,:,jpr_qnsmix) 
    1185          pqns_ice(:,:,1) = frcv(:,:,jpr_qnsmix)    & 
    1186             &            + frcv(:,:,jpr_dqnsdt) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:,1)   & 
    1187             &                                                   +          pist(:,:,1)   * zicefr(:,:,1) ) ) 
     1229! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
     1230         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1231         qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
     1232            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
     1233            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    11881234      END SELECT 
    1189       ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * lfus               ! add the latent heat of solid precip. melting 
    1190       pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)                   ! over free ocean  
    1191       IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1235      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus               ! add the latent heat of solid precip. melting 
     1236      qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)                     ! over free ocean  
     1237      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    11921238!!gm 
    11931239!!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
    … …  
    11991245      !                                      
    12001246      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    1201          ztmp(:,:) = frcv(:,:,jpr_cal) * lfus                     ! add the latent heat of iceberg melting  
    1202          pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 
    1203          IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(:,:,jpr_cal) * zcptn(:,:) )   ! heat flux from calving 
     1247         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
     1248         qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
     1249         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12041250      ENDIF 
    12051251 
    12061252      !                                                      ! ========================= ! 
    1207       SELECT CASE( TRIM( cn_rcv_qsr ) )                      !      solar heat fluxes    !   (qsr) 
     1253      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr) 
    12081254      !                                                      ! ========================= ! 
     1255      CASE( 'oce only' ) 
     1256         qsr_tot(:,:  ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 
    12091257      CASE( 'conservative' ) 
    1210          pqsr_tot(:,:  ) = frcv(:,:,jpr_qsrmix) 
    1211          pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrice) 
     1258         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1259         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1260            qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1261         ELSE 
     1262            ! Set all category values equal for the moment 
     1263            DO jl=1,jpl 
     1264               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1265            ENDDO 
     1266         ENDIF 
     1267         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1268         qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    12121269      CASE( 'oce and ice' ) 
    1213          pqsr_tot(:,:  ) =  p_frld(:,:,1) * frcv(:,:,jpr_qsroce) + zicefr(:,:,1) * frcv(:,:,jpr_qsrice) 
    1214          pqsr_ice(:,:,1) =  frcv(:,:,jpr_qsrice) 
     1270         qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1271         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1272            DO jl=1,jpl 
     1273               qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     1274               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1275            ENDDO 
     1276         ELSE 
     1277            DO jl=1,jpl 
     1278               qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1279               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1280            ENDDO 
     1281         ENDIF 
    12151282      CASE( 'mixed oce-ice' ) 
    1216          pqsr_tot(:,:  ) = frcv(:,:,jpr_qsrmix) 
     1283         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1284! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    12171285!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    12181286!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1219          pqsr_ice(:,:,1) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:,1) )   & 
    1220             &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:,1)   & 
    1221             &                     + palbi         (:,:,1) * zicefr(:,:,1) ) ) 
     1287         qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1288            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
     1289            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    12221290      END SELECT 
    12231291      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    1224          pqsr_tot(:,:  ) = sbc_dcy( pqsr_tot(:,:  ) ) 
    1225          pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) ) 
    1226       ENDIF 
    1227  
    1228       SELECT CASE( TRIM( cn_rcv_dqnsdt ) ) 
     1292         qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     1293         DO jl=1,jpl 
     1294            qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 
     1295         ENDDO 
     1296      ENDIF 
     1297 
     1298      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 
    12291299      CASE ('coupled') 
    1230           pdqns_ice(:,:,1) = frcv(:,:,jpr_dqnsdt) 
     1300         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
     1301            dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1302         ELSE 
     1303            ! Set all category values equal for the moment 
     1304            DO jl=1,jpl 
     1305               dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1306            ENDDO 
     1307         ENDIF 
    12311308      END SELECT 
    12321309 
    1233       IF( wrk_not_released(2, 1,2,3)  .OR.   & 
    1234           wrk_not_released(3, 4)      )   CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 
     1310      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
     1311      CASE ('coupled') 
     1312         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
     1313         botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 
     1314      END SELECT 
     1315 
     1316      CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     1317      ! 
     1318      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx') 
    12351319      ! 
    12361320   END SUBROUTINE sbc_cpl_ice_flx 
    … …  
    12461330      !!              all the needed fields (as defined in sbc_cpl_init) 
    12471331      !!---------------------------------------------------------------------- 
    1248       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1249       USE wrk_nemo, ONLY:   zfr_l => wrk_2d_1   ! 1. - fr_i(:,:) 
    1250       USE wrk_nemo, ONLY:   ztmp1 => wrk_2d_2 , ztmp2 => wrk_2d_3 
    1251       USE wrk_nemo, ONLY:   zotx1 => wrk_2d_4 , zoty1 => wrk_2d_5 , zotz1 => wrk_2d_6 
    1252       USE wrk_nemo, ONLY:   zitx1 => wrk_2d_7 , zity1 => wrk_2d_8 , zitz1 => wrk_2d_9 
    1253       ! 
    12541332      INTEGER, INTENT(in) ::   kt 
    12551333      ! 
    1256       INTEGER ::   ji, jj       ! dummy loop indices 
     1334      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    12571335      INTEGER ::   isec, info   ! local integer 
     1336      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
     1337      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
    12581338      !!---------------------------------------------------------------------- 
    1259  
    1260       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) ) THEN 
    1261          CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable')   ;   RETURN 
    1262       ENDIF 
     1339      ! 
     1340      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_snd') 
     1341      ! 
     1342      CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
     1343      CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
    12631344 
    12641345      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges 
    … …  
    12691350      !                                                      !    Surface temperature    !   in Kelvin 
    12701351      !                                                      ! ------------------------- ! 
    1271       SELECT CASE( cn_snd_temperature) 
    1272       CASE( 'oce only'             )   ;   ztmp1(:,:) =   tn(:,:,1) + rt0 
    1273       CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:)    
    1274                                            ztmp2(:,:) =   tn_ice(:,:,1)     *  fr_i(:,:) 
    1275       CASE( 'mixed oce-ice'        )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 
    1276       CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 
     1352      SELECT CASE( sn_snd_temp%cldes) 
     1353      CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
     1354      CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
     1355         SELECT CASE( sn_snd_temp%clcat ) 
     1356         CASE( 'yes' )    
     1357            ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1358         CASE( 'no' ) 
     1359            ztmp3(:,:,:) = 0.0 
     1360            DO jl=1,jpl 
     1361               ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1362            ENDDO 
     1363         CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1364         END SELECT 
     1365      CASE( 'mixed oce-ice'        )    
     1366         ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
     1367         DO jl=1,jpl 
     1368            ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1369         ENDDO 
     1370      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    12771371      END SELECT 
    1278       IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, ztmp1, info ) 
    1279       IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp2, info ) 
    1280       IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, ztmp1, info ) 
     1372      IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1373      IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 
     1374      IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    12811375      ! 
    12821376      !                                                      ! ------------------------- ! 
    … …  
    12841378      !                                                      ! ------------------------- ! 
    12851379      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1286          ztmp1(:,:) = alb_ice(:,:,1) * fr_i(:,:) 
    1287          CALL cpl_prism_snd( jps_albice, isec, ztmp1, info ) 
     1380         ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1381         CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 
    12881382      ENDIF 
    12891383      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
    1290          ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:,1) * fr_i(:,:) 
    1291          CALL cpl_prism_snd( jps_albmix, isec, ztmp1, info ) 
     1384         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) 
     1385         DO jl=1,jpl 
     1386            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 
     1387         ENDDO 
     1388         CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    12921389      ENDIF 
    12931390      !                                                      ! ------------------------- ! 
    12941391      !                                                      !  Ice fraction & Thickness !  
    12951392      !                                                      ! ------------------------- ! 
    1296       IF( ssnd(jps_fice)%laction )   CALL cpl_prism_snd( jps_fice, isec, fr_i                  , info ) 
    1297       IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, hicif(:,:) * fr_i(:,:), info ) 
    1298       IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, hsnif(:,:) * fr_i(:,:), info ) 
     1393      ! Send ice fraction field  
     1394      SELECT CASE( sn_snd_thick%clcat ) 
     1395         CASE( 'yes' )    
     1396            ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl) 
     1397         CASE( 'no' ) 
     1398            ztmp3(:,:,1) = fr_i(:,:) 
     1399      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1400      END SELECT 
     1401      IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 
     1402 
     1403      ! Send ice and snow thickness field  
     1404      SELECT CASE( sn_snd_thick%cldes) 
     1405      CASE( 'weighted ice and snow' )    
     1406         SELECT CASE( sn_snd_thick%clcat ) 
     1407         CASE( 'yes' )    
     1408            ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1409            ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1410         CASE( 'no' ) 
     1411            ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0 
     1412            DO jl=1,jpl 
     1413               ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 
     1414               ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 
     1415            ENDDO 
     1416         CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1417         END SELECT 
     1418      CASE( 'ice and snow'         )    
     1419         ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
     1420         ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1421      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
     1422      END SELECT 
     1423      IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 
     1424      IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 
    12991425      ! 
    13001426#if defined key_cpl_carbon_cycle 
    … …  
    13021428      !                                                      !  CO2 flux from PISCES     !  
    13031429      !                                                      ! ------------------------- ! 
    1304       IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, oce_co2 , info ) 
     1430      IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
    13051431      ! 
    13061432#endif 
     1433      !                                                      ! ------------------------- ! 
    13071434      IF( ssnd(jps_ocx1)%laction ) THEN                      !      Surface current      ! 
    13081435         !                                                   ! ------------------------- ! 
    … …  
    13161443         !                                                              i-1  i   i 
    13171444         !                                                               i      i+1 (for I) 
    1318          SELECT CASE( TRIM( cn_snd_crt(1) ) ) 
     1445         SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    13191446         CASE( 'oce only'             )      ! C-grid ==> T 
    13201447            DO jj = 2, jpjm1 
    … …  
    13941521            END SELECT 
    13951522         END SELECT 
    1396          CALL lbc_lnk( zotx1, 'T', -1. )   ;   CALL lbc_lnk( zoty1, 'T', -1. ) 
     1523         CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
    13971524         ! 
    13981525         ! 
    1399          IF( TRIM( cn_snd_crt(3) ) == 'eastward-northward' ) THEN             ! Rotation of the components 
     1526         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    14001527            !                                                                     ! Ocean component 
    14011528            CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    … …  
    14121539         ! 
    14131540         ! spherical coordinates to cartesian -> 2 components to 3 components 
    1414          IF( TRIM( cn_snd_crt(2) ) == 'cartesian' ) THEN 
     1541         IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN 
    14151542            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents 
    14161543            ztmp2(:,:) = zoty1(:,:) 
    … …  
    14241551         ENDIF 
    14251552         ! 
    1426          IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, zotx1, info )   ! ocean x current 1st grid 
    1427          IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, zoty1, info )   ! ocean y current 1st grid 
    1428          IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, zotz1, info )   ! ocean z current 1st grid 
     1553         IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
     1554         IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
     1555         IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
    14291556         ! 
    1430          IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, zitx1, info )   ! ice   x current 1st grid 
    1431          IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, zity1, info )   ! ice   y current 1st grid 
    1432          IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, zitz1, info )   ! ice   z current 1st grid 
     1557         IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
     1558         IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
     1559         IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
    14331560         !  
    14341561      ENDIF 
    14351562      ! 
    1436       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) )   CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays') 
     1563      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
     1564      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
     1565      ! 
     1566      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_snd') 
    14371567      ! 
    14381568   END SUBROUTINE sbc_cpl_snd 
    … …  
    14591589   END SUBROUTINE sbc_cpl_ice_tau 
    14601590   ! 
    1461    SUBROUTINE sbc_cpl_ice_flx( p_frld  ,                                  & 
    1462       &                        pqns_tot, pqns_ice, pqsr_tot , pqsr_ice,   & 
    1463       &                        pemp_tot, pemp_ice, pdqns_ice, psprecip,   & 
    1464       &                        palbi   , psst    , pist                ) 
    1465       REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
    1466       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
    1467       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
    1468       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
    1469       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
    1470       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget  [Kg/m2/s] 
    1471       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! ice solid freshwater budget  [Kg/m2/s] 
    1472       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
    1473       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! solid precipitation          [Kg/m2/s] 
     1591   SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  ) 
     1592      REAL(wp), INTENT(in   ), DIMENSION(:,:  ) ::   p_frld     ! lead fraction                [0 to 1] 
    14741593      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo 
    14751594      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius] 
    14761595      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin] 
    1477       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    1478       ! stupid definition to avoid warning message when compiling... 
    1479       pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0. 
    1480       pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0.  
    1481       pemp_tot(:,:) = 0. ; pemp_ice(:,:)   = 0. ; psprecip(:,:) = 0. 
     1596      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    14821597   END SUBROUTINE sbc_cpl_ice_flx 
    14831598    

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90

    r2715 r3294  
    1818   USE in_out_manager   ! I/O manager 
    1919   USE lib_mpp          ! MPP library 
     20   USE timing           ! Timing 
    2021 
    2122   IMPLICIT NONE 
    … …  
    7677         & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1) 
    7778      !!--------------------------------------------------------------------- 
    78  
     79      ! 
     80      IF( nn_timing == 1 )  CALL timing_start('sbc_dcy') 
     81      ! 
    7982      ! Initialization 
    8083      ! -------------- 
    … …  
    221224      END DO   
    222225      ! 
     226      IF( nn_timing == 1 )  CALL timing_stop('sbc_dcy') 
     227      ! 
    223228   END FUNCTION sbc_dcy 
    224229 

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

    r2715 r3294  
    2222   USE in_out_manager  ! I/O manager 
    2323   USE lib_mpp         ! distribued memory computing library 
     24   USE wrk_nemo        ! work arrays 
     25   USE timing          ! Timing 
    2426   USE lbclnk          ! ocean lateral boundary conditions 
    2527   USE lib_fortran 
    … …  
    5860      !!                   & spread out over erp area depending its sign 
    5961      !!---------------------------------------------------------------------- 
    60       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    61       USE wrk_nemo, ONLY:   ztmsk_neg      => wrk_2d_1 , ztmsk_pos => wrk_2d_2 
    62       USE wrk_nemo, ONLY:   ztmsk_tospread => wrk_2d_3 
    63       USE wrk_nemo, ONLY:   z_wgt          => wrk_2d_4 , zerp_cor  => wrk_2d_5 
    64       ! 
    6562      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    6663      INTEGER, INTENT( in ) ::   kn_fsbc  !  
    … …  
    7067      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp   ! local scalars 
    7168      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread    !   -      - 
     69      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor 
    7270      !!---------------------------------------------------------------------- 
    7371      ! 
    74       IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 
    75          CALL ctl_stop('sbc_fwb: requested workspace arrays are unavailable')   ;   RETURN 
    76       ENDIF 
     72      IF( nn_timing == 1 )  CALL timing_start('sbc_fwb') 
     73      ! 
     74      CALL wrk_alloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor ) 
    7775      ! 
    7876      IF( kt == nit000 ) THEN 
    … …  
    195193      END SELECT 
    196194      ! 
    197       IF( wrk_not_released(2, 1,2,3,4,5) )   CALL ctl_stop('sbc_fwb: failed to release workspace arrays') 
     195      CALL wrk_dealloc( jpi,jpj, ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor ) 
     196      ! 
     197      IF( nn_timing == 1 )  CALL timing_stop('sbc_fwb') 
    198198      ! 
    199199   END SUBROUTINE sbc_fwb 

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

    r2715 r3294  
    1616   USE eosbn2          ! equation of state 
    1717   USE sbc_oce         ! surface boundary condition: ocean fields 
     18   USE sbccpl 
    1819   USE fldread         ! read input field 
    1920   USE iom             ! I/O manager library 
    … …  
    9798          
    9899         fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
     100#if defined key_coupled  
     101         a_i(:,:,1) = fr_i(:,:)          
     102#endif 
    99103 
    100104         ! Flux and ice fraction computation 
    … …  
    110114               ENDIF 
    111115 
    112                tn(ji,jj,1) = MAX( tn(ji,jj,1), zt_fzp )     ! avoid over-freezing point temperature 
     116               tsn(ji,jj,1,jp_tem) = MAX( tsn(ji,jj,1,jp_tem), zt_fzp )     ! avoid over-freezing point temperature 
    113117 
    114118               qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover 
    … …  
    117121               !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0) 
    118122               !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1) 
    119                zqri = ztrp * ( tb(ji,jj,1) - ( zt_fzp - 1.) ) 
    120                zqrj = ztrp * MIN( 0., tb(ji,jj,1) - zt_fzp ) 
     123               zqri = ztrp * ( tsb(ji,jj,1,jp_tem) - ( zt_fzp - 1.) ) 
     124               zqrj = ztrp * MIN( 0., tsb(ji,jj,1,jp_tem) - zt_fzp ) 
    121125               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    & 
    122126                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1) 

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

    r2777 r3294  
    5050   USE lbclnk          ! lateral boundary condition - MPP link 
    5151   USE lib_mpp         ! MPP library 
     52   USE wrk_nemo        ! work arrays 
    5253   USE iom             ! I/O manager library 
    5354   USE in_out_manager  ! I/O manager 
    … …  
    8990      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    9091      !!--------------------------------------------------------------------- 
    91       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    92       USE wrk_nemo, ONLY:   wrk_3d_1, wrk_3d_2   ! for albedo of ice under overcast/clear sky 
    93       !! 
    9492      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    9593      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    … …  
    10098      !!---------------------------------------------------------------------- 
    10199 
    102       IF( wrk_in_use(3, 1,2) ) THEN 
    103          CALL ctl_stop( 'sbc_ice_lim: requested workspace arrays are unavailable' )   ;   RETURN 
    104       ENDIF 
    105       zalb_ice_os => wrk_3d_1(:,:,1:jpl)   ;    zalb_ice_cs => wrk_3d_2(:,:,1:jpl) 
     100      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    106101 
    107102      IF( kt == nit000 ) THEN 
    … …  
    253248!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    254249      ! 
    255       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop( 'sbc_ice_lim: failed to release workspace arrays' ) 
     250      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    256251      ! 
    257252   END SUBROUTINE sbc_ice_lim 

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

    r2715 r3294  
    4444   USE lbclnk           ! lateral boundary condition - MPP link 
    4545   USE lib_mpp          ! MPP library 
     46   USE wrk_nemo         ! work arrays 
    4647   USE iom              ! I/O manager library 
    4748   USE in_out_manager   ! I/O manager 
    … …  
    8384      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    8485      !!--------------------------------------------------------------------- 
    85       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    86       USE wrk_nemo, ONLY:   wrk_3d_1 , wrk_3d_2 , wrk_3d_3   ! 3D workspace 
    87       !! 
    8886      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    8987      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled ) 
    9088      !! 
    9189      INTEGER  ::   ji, jj   ! dummy loop indices 
    92       ! Pointers into workspaces contained in the wrk_nemo module 
    9390      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky 
    9491      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky 
    … …  
    9693      !!---------------------------------------------------------------------- 
    9794 
    98       IF( wrk_in_use(3, 1,2,3) ) THEN 
    99          CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable')   ;   RETURN 
    100       ENDIF 
    101       ! Use pointers to access only sub-arrays of workspaces 
    102       zalb_ice_os => wrk_3d_1(:,:,1:1) 
    103       zalb_ice_cs => wrk_3d_2(:,:,1:1) 
    104       zsist       => wrk_3d_3(:,:,1:1) 
     95      CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
    10596 
    10697      IF( kt == nit000 ) THEN 
    … …  
    202193#if defined key_coupled 
    203194         !                                             ! Ice surface fluxes in coupled mode  
    204          IF( ksbc == 5 )   CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),                 & 
    205             &                                             qns_tot, qns_ice, qsr_tot , qsr_ice,   & 
    206             &                                             emp_tot, emp_ice, dqns_ice, sprecip,   & 
     195         IF( ksbc == 5 )   THEN 
     196            a_i(:,:,1)=fr_i 
     197            CALL sbc_cpl_ice_flx( frld,                                              & 
    207198            !                                optional arguments, used only in 'mixed oce-ice' case 
    208199            &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 
     200            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
     201         ENDIF 
    209202#endif 
    210203                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    … …  
    228221      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    229222      ! 
    230       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('sbc_ice_lim_2: failed to release workspace arrays') 
     223      CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist ) 
    231224      ! 
    232225   END SUBROUTINE sbc_ice_lim_2 

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

    r2715 r3294  
    1111   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step 
    1212   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing 
     13   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    1314   !!---------------------------------------------------------------------- 
    1415 
    … …  
    2930   USE sbcblk_clio      ! surface boundary condition: bulk formulation : CLIO 
    3031   USE sbcblk_core      ! surface boundary condition: bulk formulation : CORE 
     32   USE sbcblk_mfs       ! surface boundary condition: bulk formulation : MFS 
    3133   USE sbcice_if        ! surface boundary condition: ice-if sea-ice model 
    3234   USE sbcice_lim       ! surface boundary condition: LIM 3.0 sea-ice model 
    3335   USE sbcice_lim_2     ! surface boundary condition: LIM 2.0 sea-ice model 
     36   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3437   USE sbccpl           ! surface boundary condition: coupled florulation 
    3538   USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    … …  
    3841   USE sbcfwb           ! surface boundary condition: freshwater budget 
    3942   USE closea           ! closed sea 
    40    USE bdy_par          ! unstructured open boundary data variables 
    41    USE bdyice           ! unstructured open boundary data  (bdy_ice_frs routine) 
     43   USE bdy_par          ! for lk_bdy 
     44   USE bdyice_lim2      ! unstructured open boundary data  (bdy_ice_lim_2 routine) 
    4245 
    4346   USE prtctl           ! Print control                    (prt_ctl routine) 
    … …  
    4649   USE in_out_manager   ! I/O manager 
    4750   USE lib_mpp          ! MPP library 
     51   USE timing           ! Timing 
     52   USE sbcwave          ! Wave module 
    4853 
    4954   IMPLICIT NONE 
    … …  
    7883      !! 
    7984      NAMELIST/namsbc/ nn_fsbc   , ln_ana , ln_flx  , ln_blk_clio, ln_blk_core, ln_cpl,   & 
    80          &             ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf     , ln_ssr     , nn_fwb 
     85         &             ln_blk_mfs, ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf, ln_ssr     , nn_fwb, ln_cdgw 
    8186      !!---------------------------------------------------------------------- 
    8287 
    … …  
    9499        IF( lk_lim2 )   nn_ice      = 2 
    95100        IF( lk_lim3 )   nn_ice      = 3 
     101        IF( lk_cice )   nn_ice      = 4 
    96102      ENDIF 
    97103      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration 
    … …  
    107113         WRITE(numout,*) '              flux       formulation                     ln_flx      = ', ln_flx 
    108114         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio = ', ln_blk_clio 
    109          WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_core = ', ln_blk_core 
     115         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
     116         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    110117         WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl 
    111118         WRITE(numout,*) '           Misc. options of sbc : ' 
    … …  
    144151         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    145152      ! 
    146       IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
    147          &   CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' ) 
     153      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
     154         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
     155      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
     156         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
     157      IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) )   & 
     158         &   CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' ) 
    148159       
    149160      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    … …  
    154165      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
    155166         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
     167 
     168       !drag coefficient read from wave model definable only with mfs bulk formulae and core  
     169       IF(ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )              & 
     170          &   CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core') 
    156171       
    157172      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    … …  
    161176      IF( ln_blk_clio     ) THEN   ;   nsbc =  3   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    162177      IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
     178      IF( ln_blk_mfs      ) THEN   ;   nsbc =  6   ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    163179      IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    164180      IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation 
    … …  
    181197         IF( nsbc ==  4 )   WRITE(numout,*) '              CORE bulk formulation' 
    182198         IF( nsbc ==  5 )   WRITE(numout,*) '              coupled formulation' 
    183       ENDIF 
     199         IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation' 
     200      ENDIF 
     201 
     202      IF( nn_ice == 4 )   CALL cice_sbc_init (nsbc) 
    184203      ! 
    185204   END SUBROUTINE sbc_init 
    … …  
    204223      INTEGER, INTENT(in) ::   kt       ! ocean time step 
    205224      !!--------------------------------------------------------------------- 
    206  
     225      ! 
     226      IF( nn_timing == 1 )  CALL timing_start('sbc') 
     227      ! 
    207228      !                                            ! ---------------------------------------- ! 
    208229      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
    … …  
    228249      !                                                  ! averaged over nf_sbc time-step 
    229250 
     251      IF (ln_cdgw) CALL sbc_wave( kt ) 
    230252                                                   !==  sbc formulation  ==! 
    231253                                                             
    … …  
    238260      CASE(  4 )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    239261      CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     262      CASE(  6 )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
    240263      CASE( -1 )                                 
    241264                       CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
    … …  
    253276         !                                                       
    254277      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )            ! LIM-2 ice model 
    255          IF( lk_bdy )      CALL bdy_ice_frs  ( kt )                  ! BDY boundary condition 
     278         IF( lk_bdy )      CALL bdy_ice_lim_2( kt )                  ! BDY boundary condition 
    256279         !                                                      
    257280      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc )            ! LIM-3 ice model 
     281         ! 
     282      CASE(  4 )   ;       CALL sbc_ice_cice ( kt, nsbc )            ! CICE ice model 
    258283      END SELECT                                               
    259284 
    … …  
    327352      ! 
    328353      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    329          CALL prt_ctl(tab2d_1=fr_i      , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
    330          CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
    331          CALL prt_ctl(tab2d_1=(emps-rnf), clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 
    332          CALL prt_ctl(tab2d_1=qns       , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
    333          CALL prt_ctl(tab2d_1=qsr       , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
    334          CALL prt_ctl(tab3d_1=tmask     , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk ) 
    335          CALL prt_ctl(tab3d_1=tn        , clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
    336          CALL prt_ctl(tab3d_1=sn        , clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
    337          CALL prt_ctl(tab2d_1=utau      , clinfo1=' utau     - : ', mask1=umask,                      & 
    338             &         tab2d_2=vtau      , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 ) 
    339       ENDIF 
     354         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
     355         CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
     356         CALL prt_ctl(tab2d_1=(emps-rnf)       , clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 
     357         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
     358         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
     359         CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk ) 
     360         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
     361         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
     362         CALL prt_ctl(tab2d_1=utau             , clinfo1=' utau     - : ', mask1=umask,                      & 
     363            &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 ) 
     364      ENDIF 
     365 
     366      IF( kt == nitend )   CALL sbc_final         ! Close down surface module if necessary 
     367      ! 
     368      IF( nn_timing == 1 )  CALL timing_stop('sbc') 
    340369      ! 
    341370   END SUBROUTINE sbc 
     371 
     372   SUBROUTINE sbc_final 
     373      !!--------------------------------------------------------------------- 
     374      !!                    ***  ROUTINE sbc_final  *** 
     375      !!--------------------------------------------------------------------- 
     376 
     377      !----------------------------------------------------------------- 
     378      ! Finalize CICE (if used) 
     379      !----------------------------------------------------------------- 
     380 
     381      IF( nn_ice == 4 )   CALL cice_sbc_final 
     382      ! 
     383   END SUBROUTINE sbc_final 
    342384 
    343385   !!====================================================================== 

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

    r2784 r3294  
    376376      ENDIF 
    377377      ! 
     378      rnf(:,:) =  0._wp                         ! runoff initialisation 
    378379      rnf_tsc(:,:,:) = 0._wp                    ! runoffs temperature & salinty contents initilisation 
    379380      ! 

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

    r2715 r3294  
    6464         ssu_m(:,:) = ub(:,:,1) 
    6565         ssv_m(:,:) = vb(:,:,1) 
    66          sst_m(:,:) = tn(:,:,1) 
    67          sss_m(:,:) = sn(:,:,1) 
     66         sst_m(:,:) = tsn(:,:,1,jp_tem) 
     67         sss_m(:,:) = tsn(:,:,1,jp_sal) 
    6868         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    6969         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    … …  
    104104               ssu_m(:,:) = zcoef * ub(:,:,1) 
    105105               ssv_m(:,:) = zcoef * vb(:,:,1) 
    106                sst_m(:,:) = zcoef * tn(:,:,1) 
    107                sss_m(:,:) = zcoef * sn(:,:,1) 
     106               sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 
     107               sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal) 
    108108               !                          ! removed inverse barometer ssh when Patm forcing is used  
    109109               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    … …  
    126126         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
    127127         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    128          sst_m(:,:) = sst_m(:,:) + tn(:,:,1) 
    129          sss_m(:,:) = sss_m(:,:) + sn(:,:,1) 
     128         sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem) 
     129         sss_m(:,:) = sss_m(:,:) + tsn(:,:,1,jp_sal) 
    130130         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    131131         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 *  ( ssh_ib(:,:) + ssh_ibb(:,:) ) 

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

    r2715 r3294  
    2121   USE lib_mpp         ! distribued memory computing library 
    2222   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     23   USE timing          ! Timing 
    2324 
    2425   IMPLICIT NONE 
    … …  
    7879      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
    7980      !!---------------------------------------------------------------------- 
     81      ! 
     82      IF( nn_timing == 1 )  CALL timing_start('sbc_ssr') 
    8083      ! 
    8184      !                                               ! -------------------- ! 
    … …  
    201204      ENDIF 
    202205      ! 
     206      IF( nn_timing == 1 )  CALL timing_stop('sbc_ssr') 
     207      ! 
    203208   END SUBROUTINE sbc_ssr 
    204209       
Note: See TracChangeset for help on using the changeset viewer.