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 886 – NEMO

Changeset 886


Ignore:
Timestamp:
2008-04-11T11:24:17+02:00 (16 years ago)
Author:
ctlod
Message:

dev_001_SBC: Step II: adapt new SBC to LIM 3.0 component, see ticket: #112

Location:
branches/dev_001_SBC/NEMO
Files:
2 added
3 deleted
32 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_001_SBC/NEMO/LIM_SRC_2/limsbc_2.F90

    r882 r886  
    8585#if defined key_coupled     
    8686      REAL(wp), DIMENSION(jpi,jpj) ::   zalb     ! albedo of ice under overcast sky 
    87       REAL(wp), DIMENSION(jpi,jpj) ::   zalcn    ! albedo of ocean under overcast sky 
    8887      REAL(wp), DIMENSION(jpi,jpj) ::   zalbp    ! albedo of ice under clear sky 
    89       REAL(wp), DIMENSION(jpi,jpj) ::   zaldum   ! albedo of ocean under clear sky 
    9088#endif 
    9189      REAL(wp) ::   zsang, zmod, zfm 
    … …  
    224222      !------------------------------------------------! 
    225223      zalb  (:,:) = 0.e0 
    226       zalcn (:,:) = 0.e0 
    227224      zalbp (:,:) = 0.e0 
    228       zaldum(:,:) = 0.e0 
    229  
    230       CALL blk_albedo( zalb, zalcn, zalbp, zaldum ) 
     225 
     226      CALL albedo_ice( sist, hicif, hsnif, zalbp, zalb ) 
    231227 
    232228      alb_ice(:,:) =  0.5 * zalbp(:,:) + 0.5 * zalb (:,:)   ! Ice albedo (mean clear and overcast skys) 

  • branches/dev_001_SBC/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    r882 r886  
    123123          zcmo(ji,jj,15) = utaui_ice(ji,jj) 
    124124          zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
    125           zcmo(ji,jj,17) = qsr_ice (ji,jj) 
    126           zcmo(ji,jj,18) = qnsr_ice(ji,jj) 
     125          zcmo(ji,jj,17) = qsr_ice(ji,jj) 
     126          zcmo(ji,jj,18) = qns_ice(ji,jj) 
    127127          zcmo(ji,jj,19) = sprecip(ji,jj) 
    128128       END DO 
    … …  
    166166                rcmoy(ji,jj,15) = utaui_ice(ji,jj) 
    167167                rcmoy(ji,jj,16) = vtaui_ice(ji,jj) 
    168                 rcmoy(ji,jj,17) = qsr_ice (ji,jj) 
    169                 rcmoy(ji,jj,18) = qnsr_ice(ji,jj) 
     168                rcmoy(ji,jj,17) = qsr_ice(ji,jj) 
     169                rcmoy(ji,jj,18) = qns_ice(ji,jj) 
    170170                rcmoy(ji,jj,19) = sprecip(ji,jj) 
    171171             END DO 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/ice.F90

    r884 r886  
    493493      diag_bot_me,                           & ! vertical bottom melt  
    494494      diag_sur_me                              ! vertical surface melt 
    495    INTEGER , PUBLIC ::   &                      !: indexes of the debugging 
    496       jiindex,           &                      !  point 
    497       jjindex 
     495   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    498496 
    499497#else 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/iceini.F90

    r884 r886  
    1313   USE in_out_manager 
    1414   USE ice_oce         ! ice variables 
    15    USE flx_oce 
     15   USE sbc_oce         ! Surface boundary condition: ocean fields 
     16   USE sbc_ice         ! Surface boundary condition: ice fields 
    1617   USE phycst          ! Define parameters for the routines 
    1718   USE ocfzpt 
    … …  
    7475      ! Louvain la Neuve Ice model 
    7576      IF( nacc == 1 ) THEN 
    76           dtsd2   = nfice * rdtmin * 0.5 
    77           rdt_ice = nfice * rdtmin 
     77          dtsd2   = nn_fsbc * rdtmin * 0.5 
     78          rdt_ice = nn_fsbc * rdtmin 
    7879      ELSE 
    79           dtsd2   = nfice * rdt * 0.5 
    80           rdt_ice = nfice * rdt 
     80          dtsd2   = nn_fsbc * rdt * 0.5 
     81          rdt_ice = nn_fsbc * rdt 
    8182      ENDIF 
    8283 
    … …  
    104105      freeze(:,:) = at_i(:,:)   ! initialisation of sea/ice cover     
    105106# if defined key_coupled 
    106       alb_ice(:,:) = albege(:,:)      ! sea-ice albedo 
     107      Must be adpated to LIM3  
     108      alb_ice(:,:,:) = albege(:,:)      ! sea-ice albedo 
    107109# endif 
    108110       
    109       nstart = numit  + nfice       
     111      nstart = numit  + nn_fsbc       
    110112      nitrun = nitend - nit000 + 1  
    111113      nlast  = numit  + nitrun  
    … …  
    188190 
    189191       WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution ' 
    190        WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     192       WRITE(numout,*) '~~~~~~~~~~~~' 
    191193 
    192194!!-- End of declarations 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limdia.F90

    r884 r886  
    2626   USE limistate 
    2727   USE dom_oce 
     28   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2829 
    2930   IMPLICIT NONE 
    … …  
    107108       !--------------------------------------- 
    108109       zday_min = 273.0        ! zday_min = date of minimum extent, here September 30th 
    109        zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(nfice) ) 
     110       zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(nn_fsbc) ) 
    110111       IF (zday.GT.zday_min) THEN  
    111112          zshift_date  =  zday - zday_min 
    … …  
    142143                vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    143144                                                        v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12  
    144                 vinfor(53) = vinfor(53) + fsalt(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux 
     145                vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux 
    145146                vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) / 1.0e12 !brine drainage flux 
    146147                vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) / 1.0e12 !equivalent salt flux 
    147                 vinfor(59) = vinfor(59) + sst_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
    148                 vinfor(61) = vinfor(61) + sss_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
     148                vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
     149                vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
    149150                vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12  ! snow temperature 
    150151                vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12       ! ice heat content 
    … …  
    155156                vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 
    156157                vinfor(79) = 0.0 
    157                 vinfor(81) = vinfor(81) + fmass(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
     158                vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
    158159             ENDIF 
    159160          END DO 
    … …  
    293294                vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    294295                                                        v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel 
    295                 vinfor(54) = vinfor(54) + at_i(ji,jj)*fsalt(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux 
     296                vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux 
    296297                vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) / 1.0e12 ! Brine drainage salt flux 
    297298                vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) / 1.0e12 ! Equivalent salt flux 
    298                 vinfor(60) = vinfor(60) + sst_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
    299                 vinfor(62) = vinfor(62) + sss_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
     299                vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
     300                vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
    300301                vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! snow temperature 
    301302                vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! ice enthalpy 
    … …  
    306307                vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 
    307308                vinfor(80) = 0.0 
    308                 vinfor(82) = vinfor(82) + fmass(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
     309                vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
    309310             ENDIF 
    310311          END DO 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limdyn.F90

    r884 r886  
    1616   USE dom_ice 
    1717   USE dom_oce         ! ocean space and time domain 
    18    USE taumod 
    1918   USE ice 
    2019   USE par_ice 
     20   USE sbc_ice         ! Surface boundary condition: ice fields 
    2121   USE ice_oce 
    2222   USE iceini 
    … …  
    9090      IF ( ln_limdyn ) THEN 
    9191 
    92          ! ocean velocity 
    93          u_oce(:,:)  = u_io(:,:) * tmu(:,:) 
    94          v_oce(:,:)  = v_io(:,:) * tmv(:,:) 
    95           
    9692         old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    9793         old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
    … …  
    162158         ENDIF 
    163159 
    164          ! Ice-Ocean stress 
    165          ! ================ 
    166          DO jj = 2, jpjm1 
    167             zsang  = SIGN(1.e0, gphif(1,jj-1) ) * sangvg 
    168  
    169             DO ji = fs_2, fs_jpim1 
    170                ! computation of wind stress over ocean in X and Y direction 
    171 #if defined key_coupled && defined key_lim_cp1 
    172 !              ztairx =  ( 1.0 - at_i(ji-1,jj)   ) * gtaux(ji-1,jj)   + & 
    173 !                        ( 1.0 - at_i(ji,jj)     ) * gtaux(ji,jj  )   + & 
    174 !                        ( 1.0 - at_i(ji-1,jj-1) ) * gtaux(ji-1,jj-1) + &  
    175 !                        ( 1.0 - at_i(ji,jj-1)   ) * gtaux(ji,jj-1) 
    176  
    177 !              ztairy =  ( 1.0 - at_i(ji-1,jj)   ) * gtauy(ji-1,jj  ) + & 
    178 !                        ( 1.0 - at_i(ji,jj  )   ) * gtauy(ji,jj    ) + & 
    179 !                        ( 1.0 - at_i(ji-1,jj-1) ) * gtauy(ji-1,jj-1) + &  
    180 !                        ( 1.0 - at_i(ji,jj-1)   ) * gtauy(ji,jj-1) 
    181 #else 
    182                ztairx =  ( 2.0 - at_i(ji,jj) - at_i(ji+1,jj) ) * gtaux(ji,jj) / cai * cao 
    183                ztairy =  ( 2.0 - at_i(ji,jj) - at_i(ji,jj+1) ) * gtauy(ji,jj) / cai * cao 
    184  
    185                zsfrldmx2 = at_i(ji,jj) + at_i(ji+1,jj) 
    186                zsfrldmy2 = at_i(ji,jj) + at_i(ji,jj+1) 
    187  
    188 #endif 
    189                zu_ice   = u_ice(ji,jj) - u_oce(ji,jj) 
    190                zv_ice   = v_ice(ji,jj) - v_oce(ji,jj) 
    191                zmod     = SQRT( zu_ice * zu_ice + zv_ice * zv_ice )  
    192  
    193                ! quadratic drag formulation 
    194                ztglx   = zsfrldmx2 * rhoco * zmod * ( cangvg * zu_ice - zsang * zv_ice )  
    195                ztgly   = zsfrldmy2 * rhoco * zmod * ( cangvg * zv_ice + zsang * zu_ice )  
    196 ! 
    197 !              ! IMPORTANT 
    198 !              ! these lignes are bound to prevent numerical oscillations 
    199 !              ! in the ice-ocean stress 
    200 !              ! They are physically ill-based. There is a cleaner solution 
    201 !              ! to try (remember discussion in Paris Gurvan) 
    202 ! 
    203                ztglx   = ztglx * exp( - zmod / 0.5 ) 
    204                ztgly   = ztglx * exp( - zmod / 0.5 ) 
    205  
    206                tio_u(ji,jj) = - ( ztairx + 1.0 * ztglx ) / ( 2. * rau0 ) 
    207                tio_v(ji,jj) = - ( ztairy + 1.0 * ztgly ) / ( 2. * rau0 ) 
    208             END DO 
    209          END DO 
    210           
    211160         ! computation of friction velocity 
    212161         DO jj = 2, jpjm1 
    213162            DO ji = fs_2, fs_jpim1 
    214163 
    215                zu_ice   = u_ice(ji,jj) - u_io(ji,jj) 
     164               zu_ice   = u_ice(ji,jj) - u_oce(ji,jj) 
    216165               zt11  = rhoco * zu_ice * zu_ice 
    217166 
    218                zu_ice   = u_ice(ji-1,jj) - u_io(ji-1,jj) 
     167               zu_ice   = u_ice(ji-1,jj) - u_oce(ji-1,jj) 
    219168               zt12  = rhoco * zu_ice * zu_ice 
    220169 
    221                zv_ice   = v_ice(ji,jj) - v_io(ji,jj) 
     170               zv_ice   = v_ice(ji,jj) - v_oce(ji,jj) 
    222171               zt21  = rhoco * zv_ice * zv_ice 
    223172 
    224                zv_ice   = v_ice(ji,jj-1) - v_io(ji,jj-1) 
     173               zv_ice   = v_ice(ji,jj-1) - v_oce(ji,jj-1) 
    225174               zt22  = rhoco * zv_ice * zv_ice 
    226                ztair2 = ( ( gtaux(ji,jj) + gtaux(ji-1,jj) ) / 2. )**2 + & 
    227                         ( ( gtauy(ji,jj) + gtauy(ji,jj-1) ) / 2. )**2 
     175               ztair2 = ( ( utaui_ice(ji,jj) + utaui_ice(ji-1,jj) ) / 2. )**2 + & 
     176                        ( ( vtaui_ice(ji,jj) + vtaui_ice(ji,jj-1) ) / 2. )**2 
    228177 
    229178               ! should not be weighted 
    … …  
    241190          DO jj = 2, jpjm1 
    242191             DO ji = fs_2, fs_jpim1 
    243 #if defined key_coupled && defined key_lim_cp1 
    244                 tio_u(ji,jj) = - (  gtaux(ji  ,jj  ) + gtaux(ji-1,jj  )       & 
    245                    &              + gtaux(ji-1,jj-1) + gtaux(ji  ,jj-1) ) / ( 4 * rau0 ) 
    246  
    247                 tio_v(ji,jj) = - (  gtauy(ji  ,jj )  + gtauy(ji-1,jj  )       & 
    248                    &              + gtauy(ji-1,jj-1) + gtauy(ji  ,jj-1) ) / ( 4 * rau0 ) 
    249 #else 
    250                 tio_u(ji,jj) = - gtaux(ji,jj) / cai * cao / rau0 
    251                 tio_v(ji,jj) = - gtauy(ji,jj) / cai * cao / rau0  
    252 #endif 
    253                 ztair2 = ( ( gtaux(ji,jj) + gtaux(ji-1,jj) ) / 2. )**2 + & 
    254                          ( ( gtauy(ji,jj) + gtauy(ji,jj-1) ) / 2. )**2 
     192                ztair2 = ( ( utaui_ice(ji,jj) + utaui_ice(ji-1,jj) ) / 2. )**2 + & 
     193                         ( ( vtaui_ice(ji,jj) + vtaui_ice(ji,jj-1) ) / 2. )**2 
    255194                zustm        = SQRT( ztair2  ) 
    256195 
    … …  
    262201 
    263202      CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point 
    264       CALL lbc_lnk( tio_u, 'U', -1. )   ! I-point (i.e. ice U-V point) 
    265       CALL lbc_lnk( tio_v, 'V', -1. )   ! I-point (i.e. ice U-V point) 
    266203 
    267204      IF(ln_ctl) THEN   ! Control print 
    … …  
    269206         CALL prt_ctl_info(' - Cell values : ') 
    270207         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    271          CALL prt_ctl(tab2d_1=tio_u     , clinfo1=' lim_dyn  : tio_u     :', tab2d_2=tio_v , clinfo2=' tio_v :') 
    272208         CALL prt_ctl(tab2d_1=ust2s     , clinfo1=' lim_dyn  : ust2s     :') 
    273209         CALL prt_ctl(tab2d_1=divu_i    , clinfo1=' lim_dyn  : divu_i    :') 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limistate.F90

    r884 r886  
    1616   USE oce             ! dynamics and tracers variables 
    1717   USE dom_oce 
     18   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1819   USE par_ice         ! ice parameters 
    1920   USE ice_oce         ! ice variables 
    … …  
    9394      CALL lim_istate_init     !  reading the initials parameters of the ice 
    9495 
    95       !-- Initialisation of sst,sss,u,v do i=1,jpi 
    96       u_io(:,:)  = 0.e0       ! ice velocity in x direction 
    97       v_io(:,:)  = 0.e0       ! ice velocity in y direction 
    98  
    9996      ! Initialisation at tn or -2 if ice 
    10097      DO jj = 1, jpj 
    … …  
    104101         END DO 
    105102      END DO 
    106  
    107       u_io  (:,:) = 0. 
    108       v_io  (:,:) = 0. 
    109       sst_io(:,:) = ( nfice - 1 ) * ( tn(:,:,1) + rt0 )   ! use the ocean initial values 
    110       sss_io(:,:) = ( nfice - 1 ) *   sn(:,:,1)           ! tricky trick *(nfice-1) ! 
    111103 
    112104      !-------------------------------------------------------------------- 
    … …  
    280272                  !--------------- 
    281273                  sm_i(ji,jj,jl)   = zidto * sinn  + ( 1.0 - zidto ) * 0.1 
    282                   smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_io(ji,jj) ) * v_i(ji,jj,jl) 
     274                  smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    283275 
    284276                  !---------- 
    … …  
    405397 
    406398                  sm_i(ji,jj,jl)   = zidto * sins  + ( 1.0 - zidto ) * 0.1 
    407                   smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_io(ji,jj) ) * v_i(ji,jj,jl) 
     399                  smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    408400 
    409401                  !---------- 
    … …  
    538530 
    539531      CALL lbc_lnk( fsbbq  , 'T', 1. ) 
    540       CALL lbc_lnk( sss_io , 'T', 1. ) 
    541532 
    542533   END SUBROUTINE lim_istate 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limitd_me.F90

    r884 r886  
    2020   USE phycst           ! physical constants (ocean directory)  
    2121   USE ice_oce          ! ice variables 
     22   USE sbc_oce          ! Surface boundary condition: ocean fields 
    2223   USE thd_ice 
    2324   USE limistate 
    … …  
    743744      ! Temporal smoothing 
    744745      !-------------------- 
    745       IF ( numit .EQ. nit000 + nfice - 1 ) THEN 
     746      IF ( numit .EQ. nit000 + nn_fsbc - 1 ) THEN 
    746747         strp1(:,:) = 0.0             
    747748         strp2(:,:) = 0.0             
    … …  
    11941195      IF ( con_i ) THEN 
    11951196         CALL lim_column_sum (jpl,   v_i, vice_init ) 
    1196          WRITE(numout,*) ' vice_init  : ', vice_init(jiindex,jjindex) 
     1197         WRITE(numout,*) ' vice_init  : ', vice_init(jiindx,jjindx) 
    11971198         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init ) 
    1198          WRITE(numout,*) ' eice_init  : ', eice_init(jiindex,jjindex) 
     1199         WRITE(numout,*) ' eice_init  : ', eice_init(jiindx,jjindx) 
    11991200      ENDIF 
    12001201 
    … …  
    13631364            ! Salinity 
    13641365            !------------- 
    1365             smsw(ji,jj)       = sss_io(ji,jj) * vsw(ji,jj) * ridge_por  
     1366            smsw(ji,jj)       = sss_m(ji,jj) * vsw(ji,jj) * ridge_por  
    13661367 
    13671368            ! salinity of new ridge 
    … …  
    14471448                                        - eirft(ji,jj,jk) 
    14481449            ! sea water heat content 
    1449             ztmelts          = - tmut * sss_io(ji,jj) + rtt 
     1450            ztmelts          = - tmut * sss_m(ji,jj) + rtt 
    14501451            ! heat content per unit volume 
    1451             zdummy0          = - rcp * ( sst_io(ji,jj) - rtt ) * vsw(ji,jj) 
     1452            zdummy0          = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 
    14521453 
    14531454            ! corrected sea water salinity 
    … …  
    16161617         fieldid = ' v_i : limitd_me ' 
    16171618         CALL lim_cons_check (vice_init, vice_final, 1.0e-6, fieldid)  
    1618          WRITE(numout,*) ' vice_init  : ', vice_init(jiindex,jjindex) 
    1619          WRITE(numout,*) ' vice_final : ', vice_final(jiindex,jjindex) 
     1619         WRITE(numout,*) ' vice_init  : ', vice_init(jiindx,jjindx) 
     1620         WRITE(numout,*) ' vice_final : ', vice_final(jiindx,jjindx) 
    16201621 
    16211622         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_final ) 
    16221623         fieldid = ' e_i : limitd_me ' 
    16231624         CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid)  
    1624          WRITE(numout,*) ' eice_init  : ', eice_init(jiindex,jjindex) 
    1625          WRITE(numout,*) ' eice_final : ', eice_final(jiindex,jjindex) 
     1625         WRITE(numout,*) ' eice_init  : ', eice_init(jiindx,jjindx) 
     1626         WRITE(numout,*) ' eice_final : ', eice_final(jiindx,jjindx) 
    16261627      ENDIF 
    16271628 
    … …  
    18391840!           fresh_hist(i,j) = fresh_hist(i,j) + xtmp 
    18401841 
    1841 !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_io(ji,jj)                  ) * &  
     1842!           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj)                  ) * &  
    18421843!                               rhosn * v_s(ji,jj,jl) / rdt_ice 
    18431844 
    1844 !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_io(ji,jj) - sm_i(ji,jj,jl) ) * &  
     1845!           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
    18451846!                               rhoic * v_i(ji,jj,jl) / rdt_ice 
    18461847 
    1847 !           fsalt(i,j)      = fsalt(i,j)      + xtmp 
     1848!           emps(i,j)      = emps(i,j)      + xtmp 
    18481849!           fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 
    18491850 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limrhg.F90

    r884 r886  
    1616   USE dom_oce 
    1717   USE dom_ice 
     18   USE sbc_ice         ! Surface boundary condition: ice fields 
    1819   USE ice 
    1920   USE iceini 
    … …  
    268269                                          / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 
    269270            ! 
    270             u_oce1(ji,jj)  = u_io(ji,jj) 
    271             v_oce2(ji,jj)  = v_io(ji,jj) 
     271            u_oce1(ji,jj)  = u_oce(ji,jj) 
     272            v_oce2(ji,jj)  = v_oce(ji,jj) 
    272273 
    273274            ! Ocean has no slip boundary condition 
    274             v_oce1(ji,jj)  = 0.5*( (v_io(ji,jj)+v_io(ji,jj-1))*e1t(ji,jj)    & 
    275                 &                 +(v_io(ji+1,jj)+v_io(ji+1,jj-1))*e1t(ji+1,jj)) & 
     275            v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    & 
     276                &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) & 
    276277                &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)   
    277278 
    278             u_oce2(ji,jj)  = 0.5*((u_io(ji,jj)+u_io(ji-1,jj))*e2t(ji,jj)     & 
    279                 &                 +(u_io(ji,jj+1)+u_io(ji-1,jj+1))*e2t(ji,jj+1)) & 
     279            u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     & 
     280                &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) & 
    280281                &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    281282 
    282283            ! Wind stress. 
    283             ztagnx = ( 1. - zfrld1(ji,jj) ) * gtaux(ji,jj) 
    284             ztagny = ( 1. - zfrld2(ji,jj) ) * gtauy(ji,jj) 
     284            ztagnx = ( 1. - zfrld1(ji,jj) ) * utaui_ice(ji,jj) 
     285            ztagny = ( 1. - zfrld2(ji,jj) ) * vtaui_ice(ji,jj) 
    285286 
    286287            ! Computation of the velocity field taking into account the ice internal interaction. 
    … …  
    621622            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    622623            IF ( zdummy .LE. 5.0e-2 ) THEN 
    623                u_ice(ji,jj) = u_io(ji,jj) 
    624                v_ice(ji,jj) = v_io(ji,jj) 
     624               u_ice(ji,jj) = u_oce(ji,jj) 
     625               v_ice(ji,jj) = v_oce(ji,jj) 
    625626            ENDIF ! zdummy 
    626627         END DO 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limrst.F90

    r884 r886  
    1818   USE dom_oce 
    1919   USE ice_oce         ! ice variables 
     20   USE sbc_oce         ! Surface boundary condition: ocean fields 
     21   USE sbc_ice         ! Surface boundary condition: ice fields 
    2022   USE daymod 
    2123   USE iom 
    … …  
    5557       
    5658      ! to get better performances with NetCDF format: 
    57       ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nfice + 1) 
    58       ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nfice + 1 
    59       IF( kt == nitrst - 2*nfice + 1 .OR. nstock == nfice .OR. ( kt == nitend - nfice + 1 .AND. .NOT. lrst_ice ) ) THEN 
     59      ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1) 
     60      ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 
     61      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    6062         ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    6163         IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    … …  
    7072            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    7173            END SELECT 
    72             IF( kt == nitrst - 2*nfice + 1 ) THEN    
    73                WRITE(numout,*)         '             kt = nitrst - 2*nfice + 1 = ', kt,' date= ', ndastp 
    74             ELSE   ;   WRITE(numout,*) '             kt = '                       , kt,' date= ', ndastp 
     74            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     75               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     76            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    7577            ENDIF 
    7678         ENDIF 
    … …  
    100102      !!---------------------------------------------------------------------- 
    101103    
    102       iter = kt + nfice - 1   ! ice restarts are written at kt == nitrst - nfice + 1 
     104      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1 
    103105 
    104106      IF( iter == nitrst ) THEN 
    … …  
    111113      ! ------------------  
    112114      !                                                                        ! calendar control 
    113       CALL iom_rstput( iter, nitrst, numriw, 'nfice' , REAL( nfice, wp) )      ! time-step  
    114       CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter , wp) )      ! date 
     115      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp) )      ! time-step  
     116      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp) )        ! date 
    115117 
    116118      ! Prognostic variables  
    … …  
    158160      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'     , u_ice      ) 
    159161      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'     , v_ice      ) 
    160       CALL iom_rstput( iter, nitrst, numriw, 'gtaux'     , gtaux      ) 
    161       CALL iom_rstput( iter, nitrst, numriw, 'gtauy'     , gtauy      ) 
     162      CALL iom_rstput( iter, nitrst, numriw, 'utaui_ice' , utaui_ice  ) 
     163      CALL iom_rstput( iter, nitrst, numriw, 'vtaui_ice' , vtaui_ice  ) 
    162164      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'     , fsbbq      ) 
    163165      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  ) 
    … …  
    299301               WRITE(numout,*) ' ~~~ Arctic' 
    300302    
    301                ji = jiindex 
    302                jj = jjindex 
     303               ji = jiindx 
     304               jj = jjindx 
    303305    
    304306               WRITE(numout,*) ' ji, jj ', ji, jj 
    … …  
    387389      !!---------------------------------------------------------------------- 
    388390      ! Local variables 
    389       INTEGER :: ji, jj, jk, jl, index 
     391      INTEGER :: ji, jj, jk, jl, indx 
    390392      REAL(wp) ::   zfice, ziter 
    391393      REAL(wp) :: & !parameters for the salinity profile 
    … …  
    405407      CALL iom_open ( 'restart_ice_in', numrir, kiolib = jprstlib ) 
    406408 
    407       CALL iom_get( numrir, 'nfice' , zfice ) 
    408       CALL iom_get( numrir, 'kt_ice', ziter )     
     409      CALL iom_get( numrir, 'nn_fsbc', zfice ) 
     410      CALL iom_get( numrir, 'kt_ice' , ziter )     
    409411      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter 
    410412      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1 
    … …  
    416418         &                   '   verify the file or rerun with the value 0 for the',        & 
    417419         &                   '   control of time parameter  nrstdt' ) 
    418       IF( INT(zfice) /= nfice          .AND. ABS( nrstdt ) == 1 )   & 
    419          &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nfice in ice restart',  & 
    420          &                   '   verify the file or rerun with the value 0 for the',        & 
     420      IF( INT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
     421         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart',  & 
     422         &                   '   verify the file or rerun with the value 0 for the',         & 
    421423         &                   '   control of time parameter  nrstdt' ) 
    422424 
    … …  
    512514      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      ) 
    513515      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    514       CALL iom_get( numrir, jpdom_autoglo, 'gtaux'     , gtaux      ) 
    515       CALL iom_get( numrir, jpdom_autoglo, 'gtauy'     , gtauy      ) 
     516      CALL iom_get( numrir, jpdom_autoglo, 'utaui_ice' , utaui_ice  ) 
     517      CALL iom_get( numrir, jpdom_autoglo, 'vtaui_ice' , vtaui_ice  ) 
    516518      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
    517519      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    … …  
    650652               WRITE(numout,*) ' ~~~ Arctic' 
    651653    
    652                index = 1 
     654               indx = 1 
    653655               ji = 24 
    654656               jj = 24 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limthd.F90

    r884 r886  
    1818   USE ice             ! LIM sea-ice variables 
    1919   USE ice_oce         ! sea-ice/ocean variables 
    20    USE flx_oce         ! sea-ice/ocean forcings variables  
     20   USE sbc_oce         ! Surface boundary condition: ocean fields 
     21   USE sbc_ice         ! Surface boundary condition: ice fields 
    2122   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    2223   USE dom_ice         ! LIM sea-ice domain 
    … …  
    8485      !!--------------------------------------------------------------------- 
    8586      !! * Local variables 
    86       INTEGER  ::  ji, jj, jk, jl,  & 
    87                    zji  , zjj,      &   ! dummy loop indices 
    88                    nbpb ,           &   ! nb of icy pts for thermo. cal. 
    89                    index 
     87      INTEGER  ::  ji, jj, jk, jl, nbpb   ! nb of icy pts for thermo. cal. 
    9088 
    9189      REAL(wp) ::  & 
    … …  
    211209 
    212210            ! here the drag will depend on ice thickness and type (0.006) 
    213             fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_io(ji,jj) - t_bo(ji,jj) )  
     211            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) )  
    214212            ! also category dependent 
    215213!           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
    … …  
    220218!           !-- Lead heat budget (part 1, next one is in limthd_dh 
    221219!           !-- qldif -- (or qldif_1d in 1d routines) 
    222             zfontn         = sprecip(ji,jj) * lfus              !   energy of melting 
    223             zfnsol         = qnsr_oce(ji,jj)  ! total non solar flux 
    224             qldif(ji,jj)   = tms(ji,jj) * ( qsr_oce(ji,jj)                          & 
     220            zfontn         = sprecip(ji,jj) * lfus              ! energy of melting 
     221            zfnsol         = qns(ji,jj)                         ! total non solar flux 
     222            qldif(ji,jj)   = tms(ji,jj) * ( qsr(ji,jj)                              & 
    225223               &                               + zfnsol + fdtcn(ji,jj) - zfontn     & 
    226224               &                               + ( 1.0 - zindb ) * fsbbq(ji,jj) )   & 
    … …  
    242240            ! Energy needed to bring ocean surface layer until its freezing 
    243241            ! qcmif, limflx 
    244             qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - sst_io(ji,jj) ) * ( 1. - zinda ) 
     242            qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) * ( 1. - zinda ) 
    245243 
    246244            !  calculate oceanic heat flux (limthd_dh) 
    … …  
    271269               ENDIF 
    272270               ! debug point to follow 
    273                IF ( (ji.eq.jiindex).AND.(jj.eq.jjindex) ) THEN 
     271               IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 
    274272                   jiindex_1d = nbpb 
    275273               ENDIF 
    … …  
    310308            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0     , jpi, jpj, npb(1:nbpb) ) 
    311309            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0     , jpi, jpj, npb(1:nbpb) ) 
    312             CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb)     , qnsr_ice(:,:,jl)  , jpi, jpj, npb(1:nbpb) ) 
     310            CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb)     , qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    313311 
    314312#if ! defined key_coupled 
    … …  
    360358 
    361359                                          !---------------------------------! 
    362             CALL lim_thd_sal(1,nbpb,jl)   ! Ice salinity computation        ! 
     360            CALL lim_thd_sal(1,nbpb)      ! Ice salinity computation        ! 
    363361                                          !---------------------------------! 
    364362 
    … …  
    415413            CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
    416414            CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    417             CALL tab_1d_2d( nbpb, qnsr_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 
     415            CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 
    418416            !+++++ 
    419417 
    … …  
    543541 
    544542      INTEGER  :: & 
    545          ji,jj,jk            ! loop indices 
     543         ji,jk               ! loop indices 
    546544 
    547545      !!----------------------------------------------------------------------- 
    … …  
    598596                                       !  is violated 
    599597      INTEGER  :: & 
    600          ji,jj,jk,                  &  !: loop indices 
     598         ji,jk,                     &  !: loop indices 
    601599         zji, zjj 
    602600      !!--------------------------------------------------------------------- 
    … …  
    726724         WRITE(numout,*) ' foc        : ', fbif_1d(ji) 
    727725         WRITE(numout,*) ' fstroc     : ', fstroc   (zji,zjj,jl) 
    728          WRITE(numout,*) ' i0        : ', i0(ji) 
    729          WRITE(numout,*) ' fsolar     : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
    730          WRITE(numout,*) ' fnsolar    : ', qnsr_ice_1d(ji) 
     726         WRITE(numout,*) ' i0         : ', i0(ji) 
     727         WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
     728         WRITE(numout,*) ' qns_ice    : ', qnsr_ice_1d(ji) 
    731729         WRITE(numout,*) ' Conduction fluxes : ' 
    732730         WRITE(numout,*) ' fc_s      : ', fc_s(ji,0:nlay_s) 
    … …  
    778776         numce                         !: number of points for which conservation 
    779777                                       !  is violated 
    780       INTEGER  :: & 
    781          ji,jj,jk,                  &  !: loop indices 
    782          zji, zjj 
    783  
     778      INTEGER  ::  ji, zji, zjj        ! loop indices 
    784779      !!--------------------------------------------------------------------- 
    785780 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limthd_dh.F90

    r884 r886  
    1616   USE phycst           ! physical constants (OCE directory)  
    1717   USE ice_oce          ! ice variables 
     18   USE sbc_oce          ! Surface boundary condition: ocean fields 
    1819   USE thd_ice 
    1920   USE iceini 
    … …  
    338339            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    339340            zfsalt_melt(ji)     = zfsalt_melt(ji) +                           & 
    340                                   ( sss_io(zji,zjj) - sm_i_b(ji)   ) *        & 
     341                                  ( sss_m(zji,zjj) - sm_i_b(ji)   ) *         & 
    341342                                  a_i_b(ji) *                                 & 
    342343                                  MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
    … …  
    368369            WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 
    369370            WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 
    370             WRITE(numout,*) ' sss_io  : ', sss_io(zji,zjj) 
     371            WRITE(numout,*) ' sss_m   : ', sss_m(zji,zjj) 
    371372         ENDIF 
    372373 
    … …  
    494495                           zswi2  * 0.26 /  & 
    495496                           ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  
    496                   zds         = zfracs*sss_io(zji,zjj) - s_i_new(ji) 
    497                   s_i_new(ji) = zfracs * sss_io(zji,zjj) 
     497                  zds         = zfracs*sss_m(zji,zjj) - s_i_new(ji) 
     498                  s_i_new(ji) = zfracs * sss_m(zji,zjj) 
    498499               ENDIF ! fc_bo_i 
    499500            END DO ! ji 
    … …  
    567568                  zjj             = ( npb(ji) - 1 ) / jpi + 1 
    568569                  zfsalt_melt(ji) = zfsalt_melt(ji) +                         & 
    569                                    ( sss_io(zji,zjj) - sm_i_b(ji)   ) *       & 
     570                                   ( sss_m(zji,zjj) - sm_i_b(ji)   ) *        & 
    570571                                   a_i_b(ji) * & 
    571572                                   MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
    … …  
    596597                WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 
    597598                WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 
    598                 WRITE(numout,*) ' sss_io  : ', sss_io(zji,zjj) 
     599                WRITE(numout,*) ' sss_m   : ', sss_m(zji,zjj) 
    599600                WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    600601                WRITE(numout,*) ' innermelt : ', innermelt(ji) 
    … …  
    701702         fseqv_1d(ji)  = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) +           & 
    702703                          (1.0 - zihgnew) * rdmicif_1d(ji) *                  & 
    703                           ( sss_io(zji,zjj) - sm_i_b(ji) ) / rdt_ice 
     704                          ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice 
    704705         ! new lines 
    705706         IF ( num_sal .EQ. 4 ) & 
    706707         fseqv_1d(ji)  = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) +           & 
    707708                          (1.0 - zihgnew) * rdmicif_1d(ji) *                  & 
    708                           ( sss_io(zji,zjj) - bulk_sal ) / rdt_ice 
     709                          ( sss_m(zji,zjj) - bulk_sal ) / rdt_ice 
    709710         ! Heat flux 
    710711         ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 
    … …  
    775776 
    776777         zsm_snowice  = ( rhoic - rhosn ) / rhoic *            & 
    777                         sss_io(zji,zjj)  
     778                        sss_m(zji,zjj)  
    778779 
    779780         IF ( num_sal .NE. 2 ) zsm_snowice = sm_i_b(ji) 
    … …  
    781782         IF ( num_sal .NE. 4 ) & 
    782783         fseqv_1d(ji)   = fseqv_1d(ji)   + & 
    783                           ( sss_io(zji,zjj) - zsm_snowice ) * & 
     784                          ( sss_m(zji,zjj) - zsm_snowice ) * & 
    784785                            a_i_b(ji)   * & 
    785786                          ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    … …  
    787788         IF ( num_sal .EQ. 4 ) & 
    788789         fseqv_1d(ji)   = fseqv_1d(ji)   + & 
    789                           ( sss_io(zji,zjj) - bulk_sal    ) * & 
     790                          ( sss_m(zji,zjj) - bulk_sal    ) * & 
    790791                            a_i_b(ji)   * & 
    791792                          ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    … …  
    804805         rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) & 
    805806                                         * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic & 
    806                                          + ( zhnnew - ht_s_b(ji) ) * rhosn ) 
     807                                         + ( zhnnew - ht_s_b(ji) ) * rhosn 
    807808#endif 
    808809!  Actualize new snow and ice thickness. 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limthd_lac.F90

    r884 r886  
    1717   USE phycst 
    1818   USE ice_oce         ! ice variables 
     19   USE sbc_oce         ! Surface boundary condition: ocean fields 
     20   USE sbc_ice         ! Surface boundary condition: ice fields 
    1921   USE thd_ice 
    2022   USE dom_ice 
    … …  
    2325   USE iceini 
    2426   USE limtab 
    25    USE taumod 
    26    USE blk_oce 
    2727   USE limcons 
    2828      
    … …  
    181181         vt_s_init, vt_s_final,   &  !  snow volume summed over categories 
    182182         et_i_init, et_i_final,   &  !  ice energy summed over categories 
    183          et_s_init, et_s_final       !  snow energy summed over categories 
     183         et_s_init                   !  snow energy summed over categories 
    184184 
    185185      REAL(wp) ::            & 
    … …  
    267267            !------------- 
    268268            ! C-grid wind stress components 
    269             ztaux         = ( gtaux(ji-1,jj  ) * tmu(ji-1,jj  ) & 
    270                           +   gtaux(ji  ,jj  ) * tmu(ji  ,jj  ) ) / 2.0 
    271             ztauy         = ( gtauy(ji  ,jj-1) * tmv(ji  ,jj-1) & 
    272                           +   gtauy(ji  ,jj  ) * tmv(ji  ,jj  ) ) / 2.0 
     269            ztaux         = ( utaui_ice(ji-1,jj  ) * tmu(ji-1,jj  ) & 
     270                          +   utaui_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) / 2.0 
     271            ztauy         = ( vtaui_ice(ji  ,jj-1) * tmv(ji  ,jj-1) & 
     272                          +   vtaui_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) / 2.0 
    273273            ! Square root of wind stress 
    274274            ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
    … …  
    343343               nbpac = nbpac + 1 
    344344               npac( nbpac ) = (jj - 1) * jpi + ji 
    345                IF ( (ji.eq.jiindex).AND.(jj.eq.jjindex) ) THEN 
     345               IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 
    346346                  jiindex_1d = nbpac 
    347347               ENDIF 
    … …  
    418418              zji            =   MOD( npac(ji) - 1, jpi ) + 1 
    419419              zjj            =   ( npac(ji) - 1 ) / jpi + 1 
    420               zs_newice(ji)  =   MIN( 0.5*sss_io(zji,zjj) , zs_newice(ji) ) 
     420              zs_newice(ji)  =   MIN( 0.5*sss_m(zji,zjj) , zs_newice(ji) ) 
    421421           END DO ! jl 
    422422 
    … …  
    476476              zjj            = ( npac(ji) - 1 ) / jpi + 1 
    477477              fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    478                                ( sss_io(zji,zjj) - bulk_sal      ) * rhoic *      & 
     478                               ( sss_m(zji,zjj) - bulk_sal      ) * rhoic *       & 
    479479                               zv_newice(ji) / rdt_ice 
    480480           END DO 
    … …  
    484484              zjj            = ( npac(ji) - 1 ) / jpi + 1 
    485485              fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    486                                ( sss_io(zji,zjj) - zs_newice(ji) ) * rhoic *      & 
     486                               ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic *       & 
    487487                               zv_newice(ji) / rdt_ice 
    488488           END DO ! ji 
    … …  
    617617        END DO 
    618618 
    619         WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex, 1:jpl) 
     619        WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 
    620620        DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    621621           DO ji = 1, nbpac 
    … …  
    626626           END DO ! ji 
    627627        END DO ! jl 
    628         WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex, 1:jpl) 
     628        WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 
    629629 
    630630        !--------------------------------- 
    … …  
    796796!     CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)  
    797797 
    798       WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindex,jjindex) 
    799       WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiindex,jjindex) 
    800       WRITE(numout,*) ' et_i_init : ', et_i_init(jiindex,jjindex) 
    801       WRITE(numout,*) ' et_i_final: ', et_i_final(jiindex,jjindex) 
     798      WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindx,jjindx) 
     799      WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiindx,jjindx) 
     800      WRITE(numout,*) ' et_i_init : ', et_i_init(jiindx,jjindx) 
     801      WRITE(numout,*) ' et_i_final: ', et_i_final(jiindx,jjindx) 
    802802 
    803803      ENDIF 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limthd_sal.F90

    r884 r886  
    1616   USE phycst           ! physical constants (ocean directory) 
    1717   USE ice_oce          ! ice variables 
     18   USE sbc_oce          ! Surface boundary condition: ocean fields 
    1819   USE thd_ice 
    1920   USE iceini 
    … …  
    4041   CONTAINS 
    4142 
    42    SUBROUTINE lim_thd_sal(kideb,kiut,jl) 
     43   SUBROUTINE lim_thd_sal(kideb,kiut) 
    4344      !!------------------------------------------------------------------- 
    4445      !!                ***  ROUTINE lim_thd_sal  ***        
    … …  
    7677      !! * Local variables 
    7778      INTEGER, INTENT(in) :: & 
    78          kideb, kiut, jl         !: thickness category index 
     79         kideb, kiut             !: thickness category index 
    7980 
    8081      INTEGER ::             & 
    … …  
    318319            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    319320            fseqv_1d(ji) = fseqv_1d(ji)              + &  
    320                            ( sss_io(zji,zjj) - bulk_sal    ) * &  
     321                           ( sss_m(zji,zjj) - bulk_sal    ) * &  
    321322                           rhoic * a_i_b(ji) * & 
    322323                           MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
    … …  
    327328            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    328329            fseqv_1d(ji) = fseqv_1d(ji)              + &  
    329                            ( sss_io(zji,zjj) - s_i_new(ji) ) * &  
     330                           ( sss_m(zji,zjj) - s_i_new(ji) ) * &  
    330331                             rhoic * a_i_b(ji) * & 
    331332                             MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limtrp.F90

    r884 r886  
    1717   USE in_out_manager  ! I/O manager 
    1818   USE ice_oce         ! ice variables 
     19   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1920   USE dom_ice 
    2021   USE ice 
    … …  
    519520 
    520521                  ! Ice salinity and age 
    521                   zsal            = MAX( MIN( (rhoic-rhosn)/rhoic*sss_io(ji,jj)  , & 
     522                  zsal            = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj)  , & 
    522523                                            zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * & 
    523524                                            v_i(ji,jj,jl) 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limupdate.F90

    r884 r886  
    2525   USE in_out_manager 
    2626   USE ice_oce         ! ice variables 
    27    USE flx_oce         ! forcings variables 
     27   USE sbc_oce         ! Surface boundary condition: ocean fields 
     28   USE sbc_ice         ! Surface boundary condition: ice fields 
    2829   USE dom_ice 
    2930   USE daymod 
    3031   USE phycst          ! Define parameters for the routines 
    31    USE taumod 
    3232   USE ice 
    3333   USE iceini 
    34    USE ocesbc 
    3534   USE lbclnk 
    3635   USE limdyn 
    3736   USE limtrp 
    3837   USE limthd 
    39    USE limflx 
     38   USE limsbc 
    4039   USE limdia 
    4140   USE limwri 
    … …  
    126125!+++++ [ 
    127126        WRITE(numout,*) ' O) Initial values ' 
    128         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    129         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    130         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    131         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    132         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    133         DO jk = 1, nlay_i 
    134         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     127        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     128        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     129        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     130        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     131        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     132        DO jk = 1, nlay_i 
     133        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    135134        END DO 
    136135!+++++ ] 
    … …  
    238237 
    239238              !residual salt flux if ice is over-molten 
    240               fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_io(ji,jj) - sm_i(ji,jj,jl) ) * &  
     239              fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
    241240                             ( rhoic * zdvres / rdt_ice ) 
    242241!             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhoic * lfus * zdvres / rdt_ice 
    … …  
    254253 
    255254              !residual salt flux if snow is over-molten 
    256               fsalt_res(ji,jj)  = fsalt_res(ji,jj) + sss_io(ji,jj) * &  
     255              fsalt_res(ji,jj)  = fsalt_res(ji,jj) + sss_m(ji,jj) * &  
    257256                             ( rhosn * zdvres / rdt_ice ) 
    258257                             !this flux will be positive if snow was over-molten 
    … …  
    276275 
    277276     WRITE(numout,*) ' 1. Before update of Global variables ' 
    278      WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    279      WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    280      WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    281         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    282      WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    283         DO jk = 1, nlay_i 
    284         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     277     WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     278     WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     279     WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     280        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     281     WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     282        DO jk = 1, nlay_i 
     283        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    285284        END DO 
    286285!+++++ ] 
    … …  
    294293     CALL lim_var_glo2eqv ! useless, just for debug 
    295294        DO jk = 1, nlay_i 
    296         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
     295        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    297296        END DO 
    298297     e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_trp(:,:,:,:)   
    … …  
    300299        WRITE(numout,*) ' After transport update ' 
    301300        DO jk = 1, nlay_i 
    302         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
     301        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    303302        END DO 
    304303     e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_thd(:,:,:,:)   
    … …  
    306305        WRITE(numout,*) ' After thermodyn update ' 
    307306        DO jk = 1, nlay_i 
    308         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
     307        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    309308        END DO 
    310309 
    … …  
    316315!+++++ [ 
    317316     WRITE(numout,*) ' 1. After update of Global variables (2) ' 
    318      WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    319      WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    320      WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    321         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    322      WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    323      WRITE(numout,*) ' oa_i : ', oa_i(jiindex, jjindex, 1:jpl) 
    324      WRITE(numout,*) ' e_s : ', e_s(jiindex, jjindex, 1, 1:jpl) 
    325         DO jk = 1, nlay_i 
    326         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     317     WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     318     WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     319     WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     320        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     321     WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     322     WRITE(numout,*) ' oa_i : ', oa_i(jiindx, jjindx, 1:jpl) 
     323     WRITE(numout,*) ' e_s : ', e_s(jiindx, jjindx, 1, 1:jpl) 
     324        DO jk = 1, nlay_i 
     325        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    327326        END DO 
    328327!+++++ ] 
    … …  
    348347!+++++ 
    349348     WRITE(numout,*) ' Before everything ' 
    350      WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    351      WRITE(numout,*) ' oa_i:  ', oa_i(jiindex, jjindex, 1:jpl) 
    352         DO jk = 1, nlay_i 
    353         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    354         END DO 
    355         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     349     WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     350     WRITE(numout,*) ' oa_i:  ', oa_i(jiindx, jjindx, 1:jpl) 
     351        DO jk = 1, nlay_i 
     352        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     353        END DO 
     354        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    356355!+++++ 
    357356 
    … …  
    362361!+++++ 
    363362     WRITE(numout,*) ' After advection   ' 
    364      WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    365         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     363     WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     364        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    366365!+++++ 
    367366 
    … …  
    401400!+++++ [ 
    402401        WRITE(numout,*) ' 2.1 ' 
    403         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    404         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    405         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    406         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    407         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    408         DO jk = 1, nlay_i 
    409         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     402        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     403        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     404        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     405        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     406        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     407        DO jk = 1, nlay_i 
     408        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    410409        END DO 
    411410!+++++ ] 
    … …  
    444443!+++++ [ 
    445444        WRITE(numout,*) ' 2.1 initial ' 
    446         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    447         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    448         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    449         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    450         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    451         DO jk = 1, nlay_i 
    452         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     445        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     446        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     447        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     448        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     449        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     450        DO jk = 1, nlay_i 
     451        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    453452        END DO 
    454453!+++++ ] 
    … …  
    464463!+++++ [ 
    465464        WRITE(numout,*) ' 2.1 before rebinning ' 
    466         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    467         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    468         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    469         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    470         DO jk = 1, nlay_i 
    471         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    472         END DO 
    473         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     465        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     466        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     467        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     468        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     469        DO jk = 1, nlay_i 
     470        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     471        END DO 
     472        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    474473!+++++ ] 
    475474 
    … …  
    483482!+++++ [ 
    484483        WRITE(numout,*) ' 2.1 after rebinning' 
    485         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    486         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    487         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    488         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    489         DO jk = 1, nlay_i 
    490         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    491         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
    492         END DO 
    493         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     484        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     485        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     486        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     487        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     488        DO jk = 1, nlay_i 
     489        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     490        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     491        END DO 
     492        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    494493!+++++ ] 
    495494 
    … …  
    611610!+++++ [ 
    612611        WRITE(numout,*) ' 2.3 after melt of an internal ice layer ' 
    613         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    614         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    615         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    616         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    617         DO jk = 1, nlay_i 
    618         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    619         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
    620         END DO 
    621         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     612        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     613        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     614        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     615        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     616        DO jk = 1, nlay_i 
     617        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     618        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     619        END DO 
     620        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    622621!+++++ ] 
    623622 
    … …  
    638637 
    639638              !++++++ 
    640               IF ( (ji.eq.jiindex) .AND. (jj.eq.jjindex) ) THEN 
     639              IF ( (ji.eq.jiindx) .AND. (jj.eq.jjindx) ) THEN 
    641640                 WRITE(numout,*) ' jl    : ', jl 
    642641                 WRITE(numout,*) ' ze_s  : ', ze_s 
    … …  
    737736!+++++ [ 
    738737        WRITE(numout,*) ' 2.8 ' 
    739         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    740         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    741         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    742         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    743         DO jk = 1, nlay_i 
    744         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    745         END DO 
    746         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     738        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     739        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     740        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     741        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     742        DO jk = 1, nlay_i 
     743        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     744        END DO 
     745        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    747746!+++++ ] 
    748747 
    … …  
    767766     WRITE(numout,*) ' 2.9 ' 
    768767     DO jk = 1, nlay_i 
    769         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    770      END DO 
    771         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    772  
    773         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     768        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     769     END DO 
     770        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     771 
     772        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    774773 
    775774     !--------------------- 
    … …  
    784783              DO ji = 1, jpi 
    785784                 ! salinity stays in bounds 
    786                  smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_io(ji,jj),smv_i(ji,jj,jl)), & 
     785                 smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), & 
    787786                  0.1 * v_i(ji,jj,jl) ) 
    788787                 i_ice_switch    =  1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) 
    … …  
    798797!+++++ [ 
    799798        WRITE(numout,*) ' 2.11 ' 
    800         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    801         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    802         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    803         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    804         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     799        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     800        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     801        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     802        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     803        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    805804!+++++ ] 
    806805 
    … …  
    826825!+++++ [ 
    827826        WRITE(numout,*) ' 2.12 ' 
    828         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    829         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    830         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    831         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    832         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     827        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     828        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     829        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     830        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     831        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    833832!+++++ ] 
    834833 
    … …  
    873872!+++++ [ 
    874873        WRITE(numout,*) ' 2.13 ' 
    875         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    876         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    877         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    878         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    879         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     874        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     875        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     876        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     877        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     878        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    880879!+++++ ] 
    881880 
    … …  
    907906!+++++ [ 
    908907        WRITE(numout,*) ' rebinning before' 
    909         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    910         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    911         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    912         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    913         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     908        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     909        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     910        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     911        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     912        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    914913!+++++ ] 
    915914!old version 
    … …  
    925924!+++++ [ 
    926925        WRITE(numout,*) ' rebinning final' 
    927         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    928         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    929         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    930         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    931         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     926        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     927        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     928        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     929        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     930        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    932931!+++++ ] 
    933932 
    … …  
    10141013     END DO !ji 
    10151014 
    1016      WRITE(numout,*) ' TESTOSC1 ', tio_u(jiindex,jjindex), tio_v(jiindex,jjindex) 
    1017      WRITE(numout,*) ' TESTOSC2 ', u_ice(jiindex,jjindex), v_ice(jiindex,jjindex) 
    1018      WRITE(numout,*) ' TESTOSC3 ', u_oce(jiindex,jjindex), v_oce(jiindex,jjindex) 
    1019      WRITE(numout,*) ' TESTOSC4 ', tauxw(jiindex,jjindex), tauxw(jiindex,jjindex) 
     1015     WRITE(numout,*) ' TESTOSC1 ', tio_u(jiindx,jjindx), tio_v(jiindx,jjindx) 
     1016     WRITE(numout,*) ' TESTOSC2 ', u_ice(jiindx,jjindx), v_ice(jiindx,jjindx) 
     1017     WRITE(numout,*) ' TESTOSC3 ', u_oce(jiindx,jjindx), v_oce(jiindx,jjindx) 
     1018     WRITE(numout,*) ' TESTOSC4 ', utau (jiindx,jjindx), vtau (jiindx,jjindx) 
    10201019 
    10211020 
    … …  
    10871086         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    10881087         CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    1089          CALL prt_ctl(tab2d_1=sst_io , clinfo1= ' lim_update : sst   : ', tab2d_2=sss_io    , clinfo2= ' sss       : ') 
     1088         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    10901089         CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update : fhbri : ', tab2d_2=fheat_rpo , clinfo2= ' fheat_rpo : ') 
    10911090 
    … …  
    10931092         CALL prt_ctl_info(' - Stresses : ') 
    10941093         CALL prt_ctl_info('   ~~~~~~~~~~ ') 
    1095          CALL prt_ctl(tab2d_1=tauxw , clinfo1= ' lim_update : tauxw : ', tab2d_2=tauyw , clinfo2= ' tauyw : ') 
    1096          CALL prt_ctl(tab2d_1=taux  , clinfo1= ' lim_update : taux  : ', tab2d_2=tauy  , clinfo2= ' tauy  : ') 
    1097          CALL prt_ctl(tab2d_1=ftaux , clinfo1= ' lim_update : ftaux : ', tab2d_2=ftauy , clinfo2= ' ftauy : ') 
    1098          CALL prt_ctl(tab2d_1=gtaux , clinfo1= ' lim_update : gtaux : ', tab2d_2=gtauy , clinfo2= ' gtauy : ') 
    1099          CALL prt_ctl(tab2d_1=u_io  , clinfo1= ' lim_update : u_io  : ', tab2d_2=v_io  , clinfo2= ' v_io  : ') 
     1094         CALL prt_ctl(tab2d_1=utau       , clinfo1= ' lim_update : utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ') 
     1095         CALL prt_ctl(tab2d_1=utaui_ice  , clinfo1= ' lim_update : utaui_ice : ', tab2d_2=vtaui_ice  , clinfo2= ' vtaui_ice : ') 
     1096         CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' lim_update : u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ') 
    11001097      ENDIF 
    11011098 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limvar.F90

    r884 r886  
    4040   USE phycst           ! physical constants (ocean directory)  
    4141   USE ice_oce          ! ice variables 
     42   USE sbc_oce          ! Surface boundary condition: ocean fields 
    4243   USE thd_ice 
    4344   USE in_out_manager 
    … …  
    428429           zind0         ,     & !: switch, = 1 if sm_i lt s_i_0 
    429430           zind01        ,     & !: switch, = 1 if sm_i between s_i_0 and s_i_1 
    430            zindbal       ,     & !: switch, = 1, if 2*sm_i gt sss_io 
     431           zindbal       ,     & !: switch, = 1, if 2*sm_i gt sss_m 
    431432           zargtemp              !: dummy factor 
    432433 
    … …  
    491492                  zind01 = ( 1.0 - zind0 ) *                                  & 
    492493                           MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i(ji,jj,jl) ) )  
    493                   ! If 2.sm_i GE sss_io then zindbal = 1 
     494                  ! If 2.sm_i GE sss_m then zindbal = 1 
    494495                  zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) -      & 
    495                   sss_io(ji,jj) ) ) 
     496                  sss_m(ji,jj) ) ) 
    496497                  zalpha(ji,jj,jl) = zind0  * 1.0                             & 
    497498                                   + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + & 
    … …  
    692693               zind01 = ( 1.0 - zind0 ) *                                  & 
    693694                        MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i_b(ji) ) )  
    694                ! if 2.sm_i GE sss_io then zindbal = 1 
     695               ! if 2.sm_i GE sss_m then zindbal = 1 
    695696               zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i_b(ji) -      & 
    696                sss_io(zji,zjj) ) ) 
     697               sss_m(zji,zjj) ) ) 
    697698 
    698699               zalpha = zind0  * 1.0                                       & 

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limwri.F90

    r884 r886  
    1818   !! * Modules used 
    1919   USE ioipsl 
    20    USE dianam    ! build name of file (routine) 
     20   USE dianam          ! build name of file (routine) 
    2121   USE phycst 
    2222   USE dom_oce 
    … …  
    2424   USE in_out_manager 
    2525   USE ice_oce         ! ice variables 
    26    USE flx_oce 
     26   USE sbc_oce         ! Surface boundary condition: ocean fields 
     27   USE sbc_ice         ! Surface boundary condition: ice fields 
    2728   USE dom_ice 
    2829   USE ice 
    … …  
    137138         zsto     = rdt_ice 
    138139         clop     = "ave(x)" 
    139          zout     = nwrite * rdt_ice / nfice 
     140         zout     = nwrite * rdt_ice / nn_fsbc 
    140141         zsec     = 0. 
    141142         niter    = 0 
    … …  
    165166         zsto     = rdt_ice 
    166167         clop     = "ave(x)" 
    167          zout     = nwrite * rdt_ice / nfice 
     168         zout     = nwrite * rdt_ice / nn_fsbc 
    168169         zsec     = 0. 
    169170         nitera   = 0 
    … …  
    221222               zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
    222223               zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)  
    223                zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qnsr_ice(ji,jj,jl)  
     224               zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl)  
    224225               zcmo(ji,jj,27) = zcmo(ji,jj,27) + t_su(ji,jj,jl)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi16)*zinda 
    225226            END DO 
    … …  
    253254     &                     / 2.0  
    254255            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj)        & 
    255      &                              + v_ice(ji,jj-1) * tmv(ji,jj-1) )      & 
     256     &                                + v_ice(ji,jj-1) * tmv(ji,jj-1) )    & 
    256257     &                     / 2.0 
    257             zcmo(ji,jj,9)  = sst_io(ji,jj) 
    258             zcmo(ji,jj,10) = sss_io(ji,jj) 
    259  
    260             zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    261             zcmo(ji,jj,12) = fsolar (ji,jj) 
    262             zcmo(ji,jj,13) = fnsolar(ji,jj) 
     258            zcmo(ji,jj,9)  = sst_m(ji,jj) 
     259            zcmo(ji,jj,10) = sss_m(ji,jj) 
     260 
     261            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     262            zcmo(ji,jj,12) = qsr(ji,jj) 
     263            zcmo(ji,jj,13) = qns(ji,jj) 
    263264            zcmo(ji,jj,14) = fhbri(ji,jj) 
    264             zcmo(ji,jj,15) = gtaux(ji,jj) 
    265             zcmo(ji,jj,16) = gtauy(ji,jj) 
    266             zcmo(ji,jj,17) = zcmo(ji,jj,17) + (1.0-at_i(ji,jj))*qsr_oce(ji,jj) 
    267             zcmo(ji,jj,18) = zcmo(ji,jj,18) + (1.0-at_i(ji,jj))*qnsr_oce (ji,jj) 
     265            zcmo(ji,jj,15) = utaui_ice(ji,jj) 
     266            zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
     267            zcmo(ji,jj,17) = zcmo(ji,jj,17) + (1.0-at_i(ji,jj))*qsr(ji,jj) 
     268            zcmo(ji,jj,18) = zcmo(ji,jj,18) + (1.0-at_i(ji,jj))*qns(ji,jj) 
    268269            zcmo(ji,jj,19) = sprecip(ji,jj) 
    269270            zcmo(ji,jj,20) = smt_i(ji,jj) 
    … …  
    299300         END DO 
    300301          
    301          IF ( jf == 7  .OR. jf == 8  .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR.   & 
    302             jf == 16 ) THEN  
     302         IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
    303303            CALL lbc_lnk( zfield, 'T', -1. ) 
    304304         ELSE  
    … …  
    315315      END DO 
    316316 
    317       IF ( ( nfice * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
     317      IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
    318318          WRITE(numout,*) ' Closing the icemod file ' 
    319319          CALL histclo( nice ) 
    … …  
    374374!     not yet implemented 
    375375       
    376       IF ( ( nfice * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
     376      IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
    377377         WRITE(numout,*) ' Closing the icemod file ' 
    378378         CALL histclo( nicea )  

  • branches/dev_001_SBC/NEMO/LIM_SRC_3/limwri_dimg.h90

    r884 r886  
    8080 
    8181       zsto     = rdt_ice 
    82        zout     = nwrite * rdt_ice / nfice 
     82       zout     = nwrite * rdt_ice / nn_fsbc 
    8383       zsec     = 0. 
    8484       niter    = 0 
    … …  
    111111               + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    112112               / ztmu 
    113           zcmo(ji,jj,9)  = sst_io(ji,jj) 
    114           zcmo(ji,jj,10) = sss_io(ji,jj) 
    115  
    116           zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    117           zcmo(ji,jj,12) = fsolar (ji,jj) 
    118           zcmo(ji,jj,13) = fnsolar(ji,jj) 
     113          zcmo(ji,jj,9)  = sst_m(ji,jj) 
     114          zcmo(ji,jj,10) = sss_m(ji,jj) 
     115 
     116          zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     117          zcmo(ji,jj,12) = qsr(ji,jj) 
     118          zcmo(ji,jj,13) = qns(ji,jj) 
    119119          ! See thersf for the coefficient 
    120           zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce 
    121           zcmo(ji,jj,15) = gtaux(ji,jj) 
    122           zcmo(ji,jj,16) = gtauy(ji,jj) 
    123           zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj) 
    124           zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj) 
     120          zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     121          zcmo(ji,jj,15) = utaui_ice(ji,jj) 
     122          zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
     123          zcmo(ji,jj,17) = qsr (ji,jj) 
     124          zcmo(ji,jj,18) = qns(ji,jj) 
    125125          zcmo(ji,jj,19) = sprecip(ji,jj) 
    126126       END DO 
    … …  
    154154                     + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    155155                     / ztmu 
    156                 rcmoy(ji,jj,9)  = sst_io(ji,jj) 
    157                 rcmoy(ji,jj,10) = sss_io(ji,jj) 
    158  
    159                 rcmoy(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    160                 rcmoy(ji,jj,12) = fsolar (ji,jj) 
    161                 rcmoy(ji,jj,13) = fnsolar(ji,jj) 
     156                rcmoy(ji,jj,9)  = sst_m(ji,jj) 
     157                rcmoy(ji,jj,10) = sss_m(ji,jj) 
     158 
     159                rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     160                rcmoy(ji,jj,12) = qsr(ji,jj) 
     161                rcmoy(ji,jj,13) = qns(ji,jj) 
    162162                ! See thersf for the coefficient 
    163                 rcmoy(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce 
    164                 rcmoy(ji,jj,15) = gtaux(ji,jj) 
    165                 rcmoy(ji,jj,16) = gtauy(ji,jj) 
    166                 rcmoy(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj) 
    167                 rcmoy(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj) 
     163                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     164                rcmoy(ji,jj,15) = utaui_ice(ji,jj) 
     165                rcmoy(ji,jj,16) = vtaui_ice(ji,jj) 
     166                rcmoy(ji,jj,17) = qsr(ji,jj) 
     167                rcmoy(ji,jj,18) = qns(ji,jj) 
    168168                rcmoy(ji,jj,19) = sprecip(ji,jj) 
    169169             END DO 
    … …  
    176176             zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 
    177177 
    178              IF ( jf == 7  .OR. jf == 8  .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR.   & 
    179                   jf == 23 .OR. jf == 24 .OR. jf == 16 ) THEN  
     178             IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
    180179                CALL lbc_lnk( zfield, 'T', -1. ) 
    181180             ELSE  

  • branches/dev_001_SBC/NEMO/OPA_SRC/DIA/diawri.F90

    r885 r886  
    1414   USE sol_oce         ! solver variables 
    1515   USE ice_oce         ! ice variables 
    16    USE sbc_oce         ! surface boundary condition: ocean 
    17    USE sbc_ice         ! surface boundary condition: ice 
     16   USE sbc_oce         ! Surface boundary condition: ocean fields 
     17   USE sbc_ice         ! Surface boundary condition: ice fields 
    1818   USE sbcssr          ! restoring term toward SST/SSS climatology 
    1919   USE phycst          ! physical constants 
    … …  
    255255         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! emp 
    256256            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    257          CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs 
    258             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     257!!$         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs 
     258!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    259259         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! emps 
    260260            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    308308#endif 
    309309 
    310 #if ( defined key_lim3  || defined key_lim2 ) && defined key_coupled 
     310#if defined key_coupled  
     311# if defined key_lim3 
     312         Must be adapted to LIM3 
     313# else 
    311314         CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    312315            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    313316         CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    314317            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     318# endif  
    315319#endif  
    316320 
    … …  
    419423!!$#endif 
    420424      CALL histwrite( nid_T, "sowaflup", it, emp           , ndim_hT, ndex_hT )   ! upward water flux 
    421       CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff 
     425!!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff 
    422426      CALL histwrite( nid_T, "sowaflcd", it, emps          , ndim_hT, ndex_hT )   ! c/d water flux 
    423427      zw2d(:,:) = emps(:,:) * sn(:,:,1) * tmask(:,:,1) 
    … …  
    452456      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content 
    453457#endif 
    454 #if ( defined key_lim3  ||  defined key_lim2 ) &&  defined key_coupled  
     458 
     459#if defined key_coupled  
     460# if defined key_lim3 
     461      Must be adapted for LIM3 
    455462      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
    456463      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
     464# else 
     465      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
     466      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
     467# endif 
    457468#endif 
    458469         ! Write fields on U grid 

  • branches/dev_001_SBC/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r881 r886  
    186186       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:) 
    187187       fsel(:,:,16) = fsel(:,:,16) + emps(:,:) 
    188 #if defined key_lim2 
    189        fsel(:,:,17) = fsel(:,:,17) + fsalt(:,:) 
    190 #endif 
    191188#ifdef key_diaspr    
    192189       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g  
    193 #endif 
    194 #if defined key_flx_core 
    195        fsel(:,:,21) = fsel(:,:,21) + qla(:,:) 
    196        fsel(:,:,22) = fsel(:,:,22) + qlw(:,:) 
    197        fsel(:,:,23) = fsel(:,:,23) + qsb(:,:) 
    198190#endif 
    199191       ! 
    … …  
    276268          !         fsel(:,:,15) =  fbt(:,:) 
    277269          fsel(:,:,16) =  emps(:,:) * tmask(:,:,1) 
    278 #if defined key_lim2 
    279           fsel(:,:,17) =  fsalt(:,:) * tmask(:,:,1) 
    280 #endif 
    281270#ifdef key_diaspr            
    282271          fsel(:,:,18) =      gps(:,:) /g 
    283272          fsel(:,:,19) =      spgu(:,:) 
    284273          fsel(:,:,20) =      spgv(:,:) 
    285 #endif 
    286 #if defined key_flx_core 
    287           fsel(:,:,21) =  qla(:,:)* tmask(:,:,1) 
    288           fsel(:,:,22) =  qlw(:,:)* tmask(:,:,1) 
    289           fsel(:,:,23) =  qsb(:,:)* tmask(:,:,1) 
    290274#endif 
    291275          ! 

  • branches/dev_001_SBC/NEMO/OPA_SRC/SBC/albedo.F90

    r881 r886  
    77   !!            8.5  !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
    88   !!            9.0  !  04-11  (C. Talandier)  add albedo_init 
    9    !!            9.0  !  06-08  (G. Madec)  cleaning for surface module 
    10    !!---------------------------------------------------------------------- 
    11  
    12    !!---------------------------------------------------------------------- 
    13    !!   blk_albedo  : albedo for ocean and ice (clear and overcast skies) 
    14    !!   albedo_init : initialisation 
    15    !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers 
     9   !!             -   !  01-06  (M. Vancoppenolle) LIM 3.0 
     10   !!             -   !  06-08  (G. Madec)  cleaning for surface module 
     11   !!---------------------------------------------------------------------- 
     12   !!   albedo_ice  : albedo for   ice (clear and overcast skies) 
     13   !!   albedo_oce  : albedo for ocean (clear and overcast skies) 
     14   !!   albedo_init : initialisation of albedo computation 
     15   !!---------------------------------------------------------------------- 
    1716   USE phycst          ! physical constants 
    18    USE in_out_manager 
     17   USE in_out_manager  ! I/O manager 
    1918 
    2019   IMPLICIT NONE 
    2120   PRIVATE 
    2221 
    23    PUBLIC   blk_albedo   ! routine called by sbcice_lim module 
    24  
    25    INTEGER  ::   albd_init = 0    !: control flag for initialization 
    26  
    27    REAL(wp) ::   zzero   = 0.e0   ! constant values 
    28    REAL(wp) ::   zone    = 1.e0   !    "       " 
     22   PUBLIC albedo_ice   ! routine called sbcice_lim.F90 
     23   PUBLIC albedo_oce   ! routine called by ??? 
     24 
     25   INTEGER  ::   albd_init = 0      !: control flag for initialization 
     26   REAL(wp) ::   zzero     = 0.e0   ! constant values 
     27   REAL(wp) ::   zone      = 1.e0   !    "       " 
    2928 
    3029   REAL(wp) ::   c1     = 0.05    ! constants values 
    3130   REAL(wp) ::   c2     = 0.10    !    "        " 
    32    REAL(wp) ::   cmue   = 0.40    !  cosine of local solar altitude 
     31   REAL(wp) ::   rmue   = 0.40    !  cosine of local solar altitude 
    3332 
    3433   !!* namelist namalb 
    … …  
    3635      cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account 
    3736      !                        !  effects of cloudiness (Grenfell & Perovich, 1984) 
     37#if defined key_lim3 
     38      albice = 0.53  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
     39#else 
    3840      albice = 0.50  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
     41#endif 
    3942      alphd  = 0.80  ,     &   !  coefficients for linear interpolation used to compute 
    4043      alphdi = 0.72  ,     &   !  albedo between two extremes values (Pyane, 1972) 
    4144      alphc  = 0.65  
    42    NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc 
    4345 
    4446   !!---------------------------------------------------------------------- 
    … …  
    5052CONTAINS 
    5153 
    52 #if defined key_lim2 
    53    !!---------------------------------------------------------------------- 
    54    !!   'key_lim2'                                        LIM 2.0 ice model 
    55    !!---------------------------------------------------------------------- 
    56  
    57    SUBROUTINE blk_albedo( palb , palcn , palbp , palcnp ) 
    58       !!---------------------------------------------------------------------- 
    59       !!               ***  ROUTINE blk_albedo  *** 
     54   SUBROUTINE albedo_ice( pt_ice, ph_ice, ph_snw, pa_ice_cs, pa_ice_os ) 
     55      !!---------------------------------------------------------------------- 
     56      !!               ***  ROUTINE albedo_ice  *** 
    6057      !!           
    6158      !! ** Purpose :   Computation of the albedo of the snow/ice system  
    … …  
    6865      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
    6966      !!---------------------------------------------------------------------- 
    70       USE ice_2             ! ??? 
    71       !! 
    72       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palb     ! albedo of ice under overcast sky 
    73       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palcn    ! albedo of ocean under overcast sky 
    74       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palbp    ! albedo of ice under clear sky  
    75       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palcnp   ! albedo of ocean under clear sky 
    76       !! 
    77       INTEGER  ::   ji, jj                   ! dummy loop indices 
    78       REAL(wp) ::   zcoef,    &   ! temporary scalar 
    79          zalbpsnm       ,     &   !  albedo of ice under clear sky when snow is melting 
    80          zalbpsnf       ,     &   !  albedo of ice under clear sky when snow is freezing 
    81          zalbpsn        ,     &   !  albedo of snow/ice system when ice is coverd by snow 
    82          zalbpic        ,     &   !  albedo of snow/ice system when ice is free of snow 
    83          zithsn         ,     &   !  = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow) 
    84          zitmlsn        ,     &   !  = 1 freezinz snow (sist >=rt0_snow) ; = 0 melting snow (sist<rt0_snow) 
    85          zihsc1         ,     &   !  = 1 hsn <= c1 ; = 0 hsn > c1 
    86          zihsc2                   !  = 1 hsn >= c2 ; = 0 hsn < c2 
    87       LOGICAL , DIMENSION(jpi,jpj) ::   llmask    !  
    88       REAL(wp), DIMENSION(jpi,jpj) ::   zalbfz    ! ( = alphdi for freezing ice ; = albice for melting ice ) 
    89       REAL(wp), DIMENSION(jpi,jpj) ::   zficeth   ! function of ice thickness 
     67      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature 
     68      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice      !  sea-ice thickness 
     69      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_snw      !  snow thickness 
     70      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_cs   !  albedo of ice under clear    sky 
     71      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_os   !  albedo of ice under overcast sky 
     72      !! 
     73      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     74      INTEGER  ::   ijpl          ! number of ice categories (3rd dim of ice input arrays) 
     75      REAL(wp) ::   zalbpsnm      ! albedo of ice under clear sky when snow is melting 
     76      REAL(wp) ::   zalbpsnf      ! albedo of ice under clear sky when snow is freezing 
     77      REAL(wp) ::   zalbpsn       ! albedo of snow/ice system when ice is coverd by snow 
     78      REAL(wp) ::   zalbpic       ! albedo of snow/ice system when ice is free of snow 
     79      REAL(wp) ::   zithsn        ! = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow) 
     80      REAL(wp) ::   zitmlsn       ! = 1 freezinz snow (pt_ice >=rt0_snow) ; = 0 melting snow (pt_ice<rt0_snow) 
     81      REAL(wp) ::   zihsc1        ! = 1 hsn <= c1 ; = 0 hsn > c1 
     82      REAL(wp) ::   zihsc2        ! = 1 hsn >= c2 ; = 0 hsn < c2 
     83      !! 
     84      LOGICAL , DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   llmask 
     85      REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zalbfz    ! = alphdi for freezing ice ; = albice for melting ice 
     86      REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zficeth   ! function of ice thickness 
    9087      !!--------------------------------------------------------------------- 
    9188       
     89      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
     90 
    9291      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    9392 
    … …  
    9594      !  Computation of  zficeth 
    9695      !--------------------------- 
    97        
    98       llmask = (hsnif == 0.e0) .AND. ( sist >= rt0_ice ) 
    99       WHERE ( llmask )   !  ice free of snow and melts 
    100          zalbfz = albice 
    101       ELSEWHERE                    
    102          zalbfz = alphdi 
     96      llmask = ( ph_snw == 0.e0 ) .AND. ( pt_ice >= rt0_ice ) 
     97      ! ice free of snow and melts 
     98      WHERE( llmask )   ;   zalbfz = albice 
     99      ELSEWHERE         ;   zalbfz = alphdi 
    103100      END WHERE 
    104        
    105       DO jj = 1, jpj 
    106          DO ji = 1, jpi 
    107             IF( hicif(ji,jj) > 1.5 ) THEN 
    108                zficeth(ji,jj) = zalbfz(ji,jj) 
    109             ELSEIF( hicif(ji,jj) > 1.0  .AND. hicif(ji,jj) <= 1.5 ) THEN 
    110                zficeth(ji,jj) = 0.472 + 2.0 * ( zalbfz(ji,jj) - 0.472 ) * ( hicif(ji,jj) - 1.0 ) 
    111             ELSEIF( hicif(ji,jj) > 0.05 .AND. hicif(ji,jj) <= 1.0 ) THEN 
    112                zficeth(ji,jj) = 0.2467 + 0.7049 * hicif(ji,jj)                                & 
    113                   &                    - 0.8608 * hicif(ji,jj) * hicif(ji,jj)                 & 
    114                   &                    + 0.3812 * hicif(ji,jj) * hicif(ji,jj) * hicif (ji,jj) 
    115             ELSE 
    116                zficeth(ji,jj) = 0.1 + 3.6 * hicif(ji,jj)  
    117             ENDIF 
     101 
     102      DO jl = 1, ijpl 
     103         DO jj = 1, jpj 
     104            DO ji = 1, jpi 
     105               IF( ph_ice(ji,jj,jl) > 1.5 ) THEN 
     106                  zficeth(ji,jj,jl) = zalbfz(ji,jj,jl) 
     107               ELSEIF( ph_ice(ji,jj,jl) > 1.0  .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN 
     108                  zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ph_ice(ji,jj,jl) - 1.0 ) 
     109               ELSEIF( ph_ice(ji,jj,jl) > 0.05 .AND. ph_ice(ji,jj,jl) <= 1.0 ) THEN 
     110                  zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ph_ice(ji,jj,jl)                               & 
     111                     &                    - 0.8608 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl)                 & 
     112                     &                    + 0.3812 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl) * ph_ice (ji,jj,jl) 
     113               ELSE 
     114                  zficeth(ji,jj,jl) = 0.1 + 3.6 * ph_ice(ji,jj,jl)  
     115               ENDIF 
     116            END DO 
    118117         END DO 
    119118      END DO 
    … …  
    125124      !    Albedo of snow-ice for clear sky. 
    126125      !-----------------------------------------------     
    127       DO jj = 1, jpj 
    128          DO ji = 1, jpi 
    129             !  Case of ice covered by snow.              
     126      DO jl = 1, ijpl 
     127         DO jj = 1, jpj 
     128            DO ji = 1, jpi 
     129               !  Case of ice covered by snow.              
     130               !                                        !  freezing snow         
     131               zihsc1   = 1.0 - MAX( zzero , SIGN( zone , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 
     132               zalbpsnf = ( 1.0 - zihsc1 ) * (  zficeth(ji,jj,jl)                                        & 
     133                  &                           + ph_snw(ji,jj,jl) * ( alphd - zficeth(ji,jj,jl) ) / c1  )   & 
     134                  &     +         zihsc1   * alphd   
     135               !                                        !  melting snow                 
     136               zihsc2   = MAX( zzero , SIGN( zone , ph_snw(ji,jj,jl) - c2 ) ) 
     137               zalbpsnm = ( 1.0 - zihsc2 ) * ( albice + ph_snw(ji,jj,jl) * ( alphc - albice ) / c2 )       & 
     138                  &     +         zihsc2   * alphc  
     139               ! 
     140               zitmlsn  =  MAX( zzero , SIGN( zone , pt_ice(ji,jj,jl) - rt0_snow ) )    
     141               zalbpsn  =  zitmlsn * zalbpsnm + ( 1.0 - zitmlsn ) * zalbpsnf 
    130142             
    131             !  melting snow         
    132             zihsc1       = 1.0 - MAX ( zzero , SIGN ( zone , - ( hsnif(ji,jj) - c1 ) ) ) 
    133             zalbpsnm     = ( 1.0 - zihsc1 ) * ( zficeth(ji,jj) + hsnif(ji,jj) * ( alphd - zficeth(ji,jj) ) / c1 ) & 
    134                &                 + zihsc1   * alphd   
    135             !  freezing snow                 
    136             zihsc2       = MAX ( zzero , SIGN ( zone , hsnif(ji,jj) - c2 ) ) 
    137             zalbpsnf     = ( 1.0 - zihsc2 ) * ( albice + hsnif(ji,jj) * ( alphc - albice ) / c2 )                 & 
    138                &                 + zihsc2   * alphc  
     143               !  Case of ice free of snow. 
     144               zalbpic  = zficeth(ji,jj,jl)  
    139145             
    140             zitmlsn      =  MAX ( zzero , SIGN ( zone , sist(ji,jj) - rt0_snow ) )    
    141             zalbpsn      =  zitmlsn * zalbpsnf + ( 1.0 - zitmlsn ) * zalbpsnm  
    142              
    143             !  Case of ice free of snow. 
    144             zalbpic      = zficeth(ji,jj)  
    145              
    146             ! albedo of the system    
    147             zithsn       = 1.0 - MAX ( zzero , SIGN ( zone , - hsnif(ji,jj) ) ) 
    148             palbp(ji,jj) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic 
     146               ! albedo of the system    
     147               zithsn   = 1.0 - MAX( zzero , SIGN( zone , - ph_snw(ji,jj,jl) ) ) 
     148               pa_ice_cs(ji,jj,jl) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic 
     149            END DO 
    149150         END DO 
    150151      END DO 
    … …  
    152153      !    Albedo of snow-ice for overcast sky. 
    153154      !----------------------------------------------   
    154       palb(:,:)   = palbp(:,:) + cgren                                            
    155        
    156       !-------------------------------------------- 
    157       !    Computation of the albedo of the ocean  
    158       !-------------------------- -----------------                                                           
    159        
    160       zcoef = 0.05 / ( 1.1 * cmue**1.4 + 0.15 )        ! Parameterization of Briegled and Ramanathan, 1982  
    161       palcnp(:,:) = zcoef 
    162       palcn(:,:)  = 0.06                               ! Parameterization of Kondratyev, 1969 and Payne, 1972 
    163       ! 
    164    END SUBROUTINE blk_albedo 
    165  
    166 # else 
    167    !!---------------------------------------------------------------------- 
    168    !!   Default option :                                   NO sea-ice model 
    169    !!---------------------------------------------------------------------- 
    170  
    171    SUBROUTINE blk_albedo( palb , palcn , palbp , palcnp ) 
    172       !!---------------------------------------------------------------------- 
    173       !!               ***  ROUTINE blk_albedo  *** 
     155      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + cgren       ! Oberhuber correction 
     156      ! 
     157   END SUBROUTINE albedo_ice 
     158 
     159 
     160   SUBROUTINE albedo_oce( pa_oce_os , pa_oce_cs ) 
     161      !!---------------------------------------------------------------------- 
     162      !!               ***  ROUTINE albedo_oce  *** 
    174163      !!  
    175164      !! ** Purpose :   Computation of the albedo of the ocean 
    … …  
    177166      !! ** Method  :   .... 
    178167      !!---------------------------------------------------------------------- 
    179       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palb     ! albedo of ice under overcast sky 
    180       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palcn    ! albedo of ocean under overcast sky 
    181       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palbp    ! albedo of ice under clear sky 
    182       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   palcnp   ! albedo of ocean under clear sky 
    183       !! 
    184       REAL(wp) ::   zcoef    ! temporary scalar 
    185       !!---------------------------------------------------------------------- 
    186       ! 
    187       zcoef = 0.05 / ( 1.1 * cmue**1.4 + 0.15 ) 
    188  
    189       palcnp(:,:) = zcoef           ! Parameterization of Briegled and Ramanathan, 1982 
    190       palcn(:,:)  = 0.06            ! Parameterization of Kondratyev, 1969 and Payne, 1972 
    191  
    192       palb (:,:)  = zcoef           ! ice overcast  albedo set to oceanvalue 
    193       palbp(:,:)  = 0.06            ! ice clear sky albedo set to oceanvalue 
    194       ! 
    195    END SUBROUTINE blk_albedo 
    196  
    197 #endif 
     168      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky 
     169      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
     170      !! 
     171      REAL(wp) ::   zcoef   ! temporary scalar 
     172      !!---------------------------------------------------------------------- 
     173      ! 
     174      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )      ! Parameterization of Briegled and Ramanathan, 1982  
     175      pa_oce_cs(:,:) = zcoef                
     176      pa_oce_os(:,:)  = 0.06                         ! Parameterization of Kondratyev, 1969 and Payne, 1972 
     177      ! 
     178   END SUBROUTINE albedo_oce 
     179 
    198180 
    199181   SUBROUTINE albedo_init 
    … …  
    205187      !! ** Method  :   Read the namelist namalb 
    206188      !!---------------------------------------------------------------------- 
    207       ! 
    208       albd_init = 1              ! set the initialization flag to 1 (done) 
    209  
    210       REWIND( numnam )           ! Read Namelist namalb : albedo parameters 
     189      NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc 
     190      !!---------------------------------------------------------------------- 
     191 
     192      ! set the initialization flag to 1 
     193      albd_init = 1           ! indicate that the initialization has been done 
     194 
     195      ! Read Namelist namalb : albedo parameters 
     196      REWIND( numnam ) 
    211197      READ  ( numnam, namalb ) 
    212198 

  • branches/dev_001_SBC/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r881 r886  
    308308 
    309309#if defined key_cpl_albedo 
     310# if defined key_lim3 
     311         Must be adapted for LIM3 
     312# endif 
    310313         tn_ice  = 271.285 
    311314    alb_ice =   0.75 

  • branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r881 r886  
    66   !! History :  9.0  !  06-08  (G. Modec)  Surface module 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_lim2 
     8#if defined key_lim3 || defined key_lim2 
    99   !!---------------------------------------------------------------------- 
    10    !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
     10   !!   'key_lim2' or 'key_lim3' :             LIM 2.0 or 3.0 sea-ice model 
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_oce          ! ocean parameters 
     13#if defined key_lim3 
     14   USE par_ice          ! ice parameters 
     15#endif 
    1316 
    1417   IMPLICIT NONE 
    1518   PRIVATE 
    1619 
    17    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utaui_ice   !: u-stress over ice (I-point)   [N/m2] 
    18    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtaui_ice   !: v-stress over ice (I-point)   [N/m2] 
     20#if defined key_lim3  
     21   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qns_ice     !: non solar heat flux over ice  [W/m2] 
     22   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qsr_ice     !: solar heat flux over ice      [W/m2] 
     23   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqns_ice    !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
     24   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tn_ice      !: ice surface temperature       [K] 
     25#else 
    1926   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_ice     !: non solar heat flux over ice  [W/m2] 
    2027   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_ice     !: solar heat flux over ice      [W/m2] 
    2128   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dqns_ice    !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
    2229   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tn_ice      !: ice surface temperature       [K] 
     30#endif 
     31 
    2332   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip     !: total precipitation           [Kg/m2/s] 
    2433   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip     !: solid precipitation           [Kg/m2/s] 
     34   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utaui_ice   !: u-stress over ice (I-point)   [N/m2] 
     35   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtaui_ice   !: v-stress over ice (I-point)   [N/m2] 
    2536   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of sol. rad.  which penetrate inside the ice cover 
    2637   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of sol. rad.  which penetrate inside the ice cover 
    2738 
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
    2939#if ! defined key_coupled 
    30       qla_ice  ,      &  !: latent flux over ice   
    31       dqla_ice           !: latent sensibility over ice 
     40 
     41# if defined key_lim3  
     42   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qla_ice   !: latent flux over ice 
     43   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqla_ice  !: latent sensibility over ice 
     44# else 
     45   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qla_ice   !: latent flux over ice 
     46   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dqla_ice  !: latent sensibility over ice 
     47# endif 
     48 
    3249#else 
    33       rrunoff  ,      &  !: runoff 
    34       calving  ,      &  !: calving 
    35       alb_ice            !: albedo of ice       
     50 
     51# if defined key_lim3  
     52   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice 
     53# else 
     54   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   alb_ice       !: albedo of ice 
     55# endif 
     56   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rrunoff       !: runoff 
     57   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   calving       !: calving 
     58 
    3659#endif 
    3760 

  • branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcana.F90

    r756 r886  
    119119      INTEGER, INTENT(in) ::   kt          ! ocean time step 
    120120 
    121       INTEGER  ::   ji, jj, js             ! dummy loop indices 
     121      INTEGER  ::   ji, jj                 ! dummy loop indices 
    122122      INTEGER  ::   zyear0                 ! initial year  
    123123      INTEGER  ::   zmonth0                ! initial month 
    124124      INTEGER  ::   zday0                  ! initial day 
    125125      INTEGER  ::   zday_year0             ! initial day since january 1st 
    126       INTEGER  ::   zdaymax                !  
    127126      REAL(wp) ::   ztau     , ztau_sais   ! wind intensity and of the seasonal cycle 
    128127      REAL(wp) ::   ztime                  ! time in hour 
    … …  
    283282         WRITE(numout,*)'           adatrj     = ',adatrj 
    284283         WRITE(numout,*)'           ztime      = ',ztime 
    285          WRITE(numout,*)'           zdaymax    = ',zdaymax 
    286284 
    287285         WRITE(numout,*)'           ztimemax   = ',ztimemax 

  • branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r881 r886  
    3030   USE albedo 
    3131   USE prtctl          ! Print control 
    32 #if defined key_lim2 
     32#if defined key_lim3 
     33   USE par_ice 
     34   USE ice 
     35#elif defined key_lim2 
    3336   USE par_ice_2 
    3437   USE ice_2 
    … …  
    4144 
    4245   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read  
    43    INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at U-point 
    44    INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at V-point 
     46   INTEGER , PARAMETER ::   jp_utau = 1           ! index of wind stress (i-component)      (N/m2)    at U-point 
     47   INTEGER , PARAMETER ::   jp_vtau = 2           ! index of wind stress (j-component)      (N/m2)    at V-point 
    4548   INTEGER , PARAMETER ::   jp_wndm = 3           ! index of 10m wind module                 (m/s)    at T-point 
    4649   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % ) 
    … …  
    4952   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
    5053   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
    51  
    52  
    53    !!  
    54 !!!!gm  to be moved 
    55    INTEGER, PARAMETER  ::   jpl = 1          ! number of layer in the ice   
    56 !!!!gm  to be moved 
    57  
    5854 
    5955   INTEGER, PARAMETER  ::   jpintsr = 24          ! number of time step between sunrise and sunset 
    … …  
    127123      CHARACTER(len=100) ::  cn_dir                            !   Root directory for location of CLIO files 
    128124      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read 
    129       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_wndm, sn_tair      ! informations about the fields to be read 
     125      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_wndm, sn_tair      ! informations about the fields to be read 
    130126      TYPE(FLD_N) ::   sn_humi, sn_ccov, sn_prec               !   "                                 " 
    131127      !! 
    132       NAMELIST/namsbc_clio/ cn_dir, sn_wndi, sn_wndj, sn_wndm, sn_humi,   & 
     128      NAMELIST/namsbc_clio/ cn_dir, sn_utau, sn_vtau, sn_wndm, sn_humi,   & 
    133129         &                          sn_ccov, sn_tair, sn_prec 
    134130      !!--------------------------------------------------------------------- 
    … …  
    143139         !            !    file     ! frequency !  variable  ! time intep !  clim  ! starting ! 
    144140         !            !    name     !  (hours)  !   name     !   (T/F)    !  (0/1) !  record  ! 
    145          sn_wndi = FLD_N( 'uwnd10m' ,    24.    ,  'u_10'    ,  .true.    ,    0   ,     0    )  
    146          sn_wndj = FLD_N( 'vwnd10m' ,    24.    ,  'v_10'    ,  .true.    ,    0   ,     0    )  
     141         sn_utau = FLD_N( 'utau'    ,    24.    ,  'utau'    ,  .true.    ,    0   ,     0    )  
     142         sn_vtau = FLD_N( 'vtau'    ,    24.    ,  'vtau'    ,  .true.    ,    0   ,     0    )  
    147143         sn_wndm = FLD_N( 'mwnd10m' ,    24.    ,  'm_10'    ,  .true.    ,    0   ,     0    )  
    148144         sn_tair = FLD_N( 'tair10m' ,    24.    ,  't_10'    ,  .FALSE.   ,    0   ,     0    )  
    … …  
    155151 
    156152         ! store namelist information in an array 
    157          slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj   ;   slf_i(jp_wndm) = sn_wndm 
     153         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau   ;   slf_i(jp_wndm) = sn_wndm 
    158154         slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    159155         slf_i(jp_ccov) = sn_ccov   ;   slf_i(jp_prec) = sn_prec 
    … …  
    203199            WRITE(numout,*) 
    204200            ifpr = INT(jpi/8)      ;      jfpr = INT(jpj/10) 
    205             WRITE(numout,*) TRIM(sf(jp_wndi)%clvar),' day: ',ndastp 
    206             CALL prihre( sf(jp_wndi)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout ) 
     201            WRITE(numout,*) TRIM(sf(jp_utau)%clvar),' day: ',ndastp 
     202            CALL prihre( sf(jp_utau)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout ) 
    207203            WRITE(numout,*) 
    208             WRITE(numout,*) TRIM(sf(jp_wndj)%clvar),' day: ',ndastp 
    209             CALL prihre( sf(jp_wndj)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout ) 
     204            WRITE(numout,*) TRIM(sf(jp_vtau)%clvar),' day: ',ndastp 
     205            CALL prihre( sf(jp_vtau)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout ) 
    210206            WRITE(numout,*) 
    211207            WRITE(numout,*) TRIM(sf(jp_humi)%clvar),' day: ',ndastp 
    … …  
    246242      !!       follow the work of Oberhuber, 1988    
    247243      !!               - momentum flux (stresses) directly read in files at U- and V-points 
    248       !!               - compute ocean and ice albedos (call flx_blk_albedo)   
     244      !!               - compute ocean/ice albedos (call albedo_oce/albedo_ice)   
    249245      !!               - compute shortwave radiation for ocean (call blk_clio_qsr_oce) 
    250246      !!               - compute long-wave radiation for the ocean 
    … …  
    269265      REAL(wp) ::   zdtetar, ztvmoyr, zlxins, zchcm, zclcm      !    -         - 
    270266      REAL(wp) ::   zmt1, zmt2, zmt3, ztatm3, ztamr, ztaevbk    !    -         - 
    271       REAL(wp) ::   zsst, ztatm, zcco1, zpatm                   !    -         - 
     267      REAL(wp) ::   zsst, ztatm, zcco1, zpatm, zinda            !    -         - 
    272268      REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         - 
    273269      !! 
    … …  
    285281      DO jj = 1 , jpj 
    286282         DO ji = 1, jpi 
    287             utau(ji,jj) = sf(jp_wndi)%fnow(ji,jj) 
    288             vtau(ji,jj) = sf(jp_wndj)%fnow(ji,jj) 
     283            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj) 
     284            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj) 
    289285         END DO 
    290286      END DO 
    … …  
    295291       
    296292      CALL blk_clio_qsr_oce( qsr ) 
     293 
     294      ! CAUTION: ocean shortwave radiation sets to zero if more than 50% of sea-ice !!gm to be removed 
     295      DO jj = 1, jpj 
     296         DO ji = 1, jpi 
     297            zinda    = MAX(  0.e0, SIGN(  1.e0, -( -1.5 - freeze(ji,jj) )  )  ) 
     298            qsr(ji,jj) = zinda * qsr(ji,jj) 
     299         END DO 
     300      END DO 
    297301 
    298302 
    … …  
    423427      !!       follow the work of Oberhuber, 1988    
    424428      !! 
    425       !!  ** Action  :   call flx_blk_albedo to compute ocean and ice albedo  
     429      !!  ** Action  :   call albedo_oce/albedo_ice to compute ocean/ice albedo  
    426430      !!          computation of snow precipitation 
    427431      !!          computation of solar flux at the ocean and ice surfaces 
    … …  
    433437      !! 
    434438      !!---------------------------------------------------------------------- 
    435       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl) ::   pst      ! ice surface temperature                   [Kelvin] 
    436       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)     ::   pui      ! ice surface velocity (i-component, I-point)  [m/s] 
    437       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)     ::   pvi      ! ice surface velocity (j-component, I-point)  [m/s] 
    438       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl) ::   palb_cs  ! ice albedo (clear sky) (alb_ice_cs)            [%] 
    439       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl) ::   palb_os  ! ice albedo (overcast sky) (alb_ice_cs)         [%] 
    440       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2] 
    441       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2] 
    442       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   p_qns    ! non solar heat flux over ice (T-point)      [W/m2] 
    443       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   p_qsr    !     solar heat flux over ice (T-point)      [W/m2] 
    444       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   p_qla    ! latent    heat flux over ice (T-point)      [W/m2] 
    445       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   p_dqns   ! non solar heat sensistivity  (T-point)      [W/m2] 
    446       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   p_dqla   ! latent    heat sensistivity  (T-point)      [W/m2] 
    447       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   p_tpr    ! total precipitation          (T-point)       [Kg/m2/s] 
    448       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   p_spr    ! solid precipitation          (T-point)       [Kg/m2/s] 
    449       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   p_fr1    ! 1sr fraction of qsr penetration in ice             [%] 
    450       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   p_fr2    ! 2nd fraction of qsr penetration in ice             [%] 
    451       CHARACTER(len=1), INTENT(in   )                 ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid) 
     439      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)  ::   pst      ! ice surface temperature                   [Kelvin] 
     440      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pui      ! ice surface velocity (i-component, I-point)  [m/s] 
     441      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pvi      ! ice surface velocity (j-component, I-point)  [m/s] 
     442      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%] 
     443      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [%] 
     444      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2] 
     445      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2] 
     446      REAL(wp), INTENT(  out), DIMENSION(:,:,:)  ::   p_qns    ! non solar heat flux over ice (T-point)      [W/m2] 
     447      REAL(wp), INTENT(  out), DIMENSION(:,:,:)  ::   p_qsr    !     solar heat flux over ice (T-point)      [W/m2] 
     448      REAL(wp), INTENT(  out), DIMENSION(:,:,:)  ::   p_qla    ! latent    heat flux over ice (T-point)      [W/m2] 
     449      REAL(wp), INTENT(  out), DIMENSION(:,:,:)  ::   p_dqns   ! non solar heat sensistivity  (T-point)      [W/m2] 
     450      REAL(wp), INTENT(  out), DIMENSION(:,:,:)  ::   p_dqla   ! latent    heat sensistivity  (T-point)      [W/m2] 
     451      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s] 
     452      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s] 
     453      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [%] 
     454      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [%] 
     455      CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid) 
    452456      !! 
    453457      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     458      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    454459      !! 
    455460      REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3             ! temporary scalars 
    … …  
    464469      REAL(wp), DIMENSION(jpi,jpj) ::   zevsqr  ! vapour pressure square-root 
    465470      REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa   ! air density 
    466       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qlw, z_qsb 
     471      REAL(wp), DIMENSION(jpi,jpj,SIZE(pst,3)) ::   z_qlw, z_qsb 
    467472      !!--------------------------------------------------------------------- 
    468473 
     474      ijpl  = SIZE( pst, 3 )                 ! number of ice categories 
    469475      zpatm = 101000.                        ! atmospheric pressure  (assumed constant  here) 
    470476 
    … …  
    548554 
    549555      !                                     ! ========================== ! 
    550       DO jl = 1, jpl                        !  Loop over ice categories  ! 
     556      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    551557         !                                  ! ========================== ! 
    552558!CDIR NOVERRCHK 
    … …  
    602608               p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
    603609            END DO 
    604          END DO 
    605       END DO 
    606  
     610            ! 
     611         END DO 
     612         ! 
     613      END DO 
    607614      ! 
    608615      ! ----------------------------------------------------------------------------- ! 
    609       !     III    Total FLUXES                                                       ! 
     616      !    Total FLUXES                                                       ! 
    610617      ! ----------------------------------------------------------------------------- ! 
    611618      ! 
    612619!CDIR COLLAPSE 
    613       p_qns(:,:,:) =     z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    614 !CDIR COLLAPSE 
    615       p_tpr(:,:) = sf(jp_prec)%fnow(:,:) / rday     ! total precipitation [kg/m2/s] 
     620      p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
     621!CDIR COLLAPSE 
     622      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:) / rday                       ! total precipitation [kg/m2/s] 
    616623      ! 
    617624!!gm : not necessary as all input data are lbc_lnk... 
    618625      CALL lbc_lnk( p_fr1  (:,:) , 'T', 1. ) 
    619626      CALL lbc_lnk( p_fr2  (:,:) , 'T', 1. ) 
    620       DO jl = 1, jpl 
     627      DO jl = 1, ijpl 
    621628         CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. ) 
    622629         CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. ) 
    … …  
    626633 
    627634!!gm : mask is not required on forcing 
    628       DO jl = 1, jpl 
     635      DO jl = 1, ijpl 
    629636         p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 
    630637         p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 
    … …  
    634641 
    635642      IF(ln_ctl) THEN 
    636          CALL prt_ctl(tab2d_1=z_qsb(:,:,jpl) , clinfo1=' blk_ice_clio: z_qsb   : ', tab2d_2=z_qlw(:,:,jpl), clinfo2=' z_qlw  : ') 
    637          CALL prt_ctl(tab2d_1=p_qla(:,:,jpl) , clinfo1=' blk_ice_clio: z_qla   : ', tab2d_2=p_qsr(:,:,jpl), clinfo2=' p_qsr  : ') 
    638          CALL prt_ctl(tab2d_1=p_tpr(:,:,jpl) , clinfo1=' blk_ice_clio: p_tpr   : ', tab2d_2=p_spr         , clinfo2=' p_spr  : ') 
    639          CALL prt_ctl(tab2d_1=p_taui         , clinfo1=' blk_ice_clio: p_taui  : ', tab2d_2=p_tauj        , clinfo2=' p_tauj : ') 
    640          CALL prt_ctl(tab2d_1=pst(:,:,jpl)   , clinfo2=' blk_ice_clio: pst     : ') 
     643         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=ijpl) 
     644         CALL prt_ctl(tab3d_1=p_qla  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=p_qsr  , clinfo2=' p_qsr  : ', kdim=ijpl) 
     645         CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns  , clinfo2=' p_qns  : ', kdim=ijpl) 
     646         CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst    , clinfo2=' pst    : ', kdim=ijpl) 
     647         CALL prt_ctl(tab2d_1=p_tpr  , clinfo1=' blk_ice_clio: p_tpr  : ', tab2d_2=p_spr  , clinfo2=' p_spr  : ') 
     648         CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 
    641649      ENDIF 
    642650 
    … …  
    667675      REAL(wp)  ::   zmt1, zmt2, zmt3                !  
    668676      REAL(wp)  ::   zdecl, zsdecl , zcdecl          !  
    669       REAL(wp)  ::   za_oce, ztamr, zinda             ! 
    670  
    671       REAL(wp) ::   zdl, zlha     ! local scalars 
    672       REAL(wp) ::   zlmunoon, zcldcor, zdaycor            !    
    673       REAL(wp) ::   zxday, zdist, zcoef, zcoef1           ! 
     677      REAL(wp)  ::   za_oce, ztamr                   ! 
     678 
     679      REAL(wp) ::   zdl, zlha                        ! local scalars 
     680      REAL(wp) ::   zlmunoon, zcldcor, zdaycor       !    
     681      REAL(wp) ::   zxday, zdist, zcoef, zcoef1      ! 
    674682      REAL(wp) ::   zes 
    675683      !! 
    676       REAL(wp), DIMENSION(jpi,jpj) ::   zev         ! vapour pressure 
     684      REAL(wp), DIMENSION(jpi,jpj) ::   zev          ! vapour pressure 
    677685      REAL(wp), DIMENSION(jpi,jpj) ::   zdlha, zlsrise, zlsset     ! 2D workspace 
    678686 
    … …  
    786794      END DO 
    787795      ! Taking into account the ellipsity of the earth orbit, the clouds AND masked if sea-ice cover > 0% 
    788 !!gm : bug zinda is always 0 si ice.... 
    789796      zcoef1 = srgamma * zdaycor / ( 2. * rpi ) 
    790797!CDIR COLLAPSE 
    … …  
    794801            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj)   &       ! cloud correction (Reed 1977) 
    795802               &                          + 0.0019 * zlmunoon )                 ) 
    796             zinda    = MAX(  0.e0, SIGN(  1.e0, -( -1.5 + freeze(ji,jj) )  )   )            ! 0 if more than 0% of ice 
    797             pqsr_oce(ji,jj) = zcoef1 * zcldcor * zinda * pqsr_oce(ji,jj) * tmask(ji,jj,1)   ! and zcoef1: ellipsity 
     803            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)   ! and zcoef1: ellipsity 
    798804         END DO 
    799805      END DO 
    … …  
    812818      !!               - also initialise sbudyko and stauc once for all  
    813819      !!---------------------------------------------------------------------- 
    814       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl) ::   pa_ice_cs   ! albedo of ice under clear sky 
    815       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl) ::   pa_ice_os   ! albedo of ice under overcast sky 
    816       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pqsr_ice    ! shortwave radiation over the ice/snow 
     820      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_cs   ! albedo of ice under clear sky 
     821      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_os   ! albedo of ice under overcast sky 
     822      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice    ! shortwave radiation over the ice/snow 
    817823      !! 
    818824      INTEGER, PARAMETER  ::   jp24 = 24   ! sampling of the daylight period (sunrise to sunset) into 24 equal parts 
    819825      !! 
    820826      INTEGER  ::   ji, jj, jl, jt    ! dummy loop indices 
     827      INTEGER  ::   ijpl              ! number of ice categories (3rd dim of pqsr_ice) 
    821828      INTEGER  ::   indaet            !  = -1, 0, 1 for odd, normal and leap years resp. 
    822829      INTEGER  ::   iday              ! integer part of day 
    823  
    824       REAL(wp)  ::   zcmue, zcmue2    ! local scalars  
    825       REAL(wp)  ::   zmt1, zmt2, zmt3                !  
    826       REAL(wp)  ::   zdecl, zsdecl , zcdecl          !  
    827       REAL(wp)  ::   ztamr             ! 
    828  
    829       REAL(wp) ::   zlha     ! local scalars 
    830       REAL(wp) ::   zdaycor            ! 
    831       REAL(wp) ::   zxday, zdist, zcoef, zcoef1           ! 
    832       REAL(wp) ::   zes 
    833       REAL(wp) ::   zqsr_ice_cs, zqsr_ice_os 
    834       !! 
    835       REAL(wp), DIMENSION(jpi,jpj) ::   zev         ! vapour pressure 
    836       REAL(wp), DIMENSION(jpi,jpj) ::   zdlha, zlsrise, zlsset     ! 2D workspace 
    837         
     830      !! 
     831      REAL(wp) ::   zcmue, zcmue2, ztamr          ! temporary scalars  
     832      REAL(wp) ::   zmt1, zmt2, zmt3              !    -         - 
     833      REAL(wp) ::   zdecl, zsdecl, zcdecl         !    -         - 
     834      REAL(wp) ::   zlha, zdaycor, zes            !    -         - 
     835      REAL(wp) ::   zxday, zdist, zcoef, zcoef1   !    -         - 
     836      REAL(wp) ::   zqsr_ice_cs, zqsr_ice_os      !    -         - 
     837      !! 
     838      REAL(wp), DIMENSION(jpi,jpj) ::   zev                      ! vapour pressure 
     839      REAL(wp), DIMENSION(jpi,jpj) ::   zdlha, zlsrise, zlsset   ! 2D workspace 
    838840      REAL(wp), DIMENSION(jpi,jpj) ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
    839841      !!--------------------------------------------------------------------- 
     842 
     843      ijpl = SIZE(pqsr_ice, 3 )      ! number of ice categories 
    840844       
    841845      ! Saturated water vapour and vapour pressure 
    … …  
    895899      ! compute and sum ice qsr over the daylight for each ice categories 
    896900      pqsr_ice(:,:,:) = 0.e0 
    897       zcoef1 = zdaycor / ( 2. * rpi ) 
     901      zcoef1 = zdaycor / ( 2. * rpi )       ! Correction for the ellipsity of the earth orbit 
    898902       
    899903      !                    !----------------------------!  
    900       DO jl = 1, jpl       !  loop over ice categories  ! 
     904      DO jl = 1, ijpl      !  loop over ice categories  ! 
    901905         !                 !----------------------------!  
    902906!CDIR NOVERRCHK    
    … …  
    930934         !                 !--------------------------------!  
    931935      END DO               !  end loop over ice categories  ! 
    932          !                 !--------------------------------!  
     936      !                    !--------------------------------!  
    933937 
    934938 
    935939!!gm  : this should be suppress as input data have been passed through lbc_lnk 
    936       DO jl = 1, jpl 
     940      DO jl = 1, ijpl 
    937941         CALL lbc_lnk( pqsr_ice(:,:,jl) , 'T', 1. ) 
    938942      END DO 

  • branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r879 r886  
    44   !! Ocean forcing:  momentum, heat and freshwater flux formulation 
    55   !!===================================================================== 
    6    !! History :  9.0   !  04-08  (U. Schweckendiek)  Original code 
    7    !!                  !  05-04  (L. Brodeau, A.M. Treguier) additions:  
     6   !! History :  1.0   !  04-08  (U. Schweckendiek)  Original code 
     7   !!            2.0   !  05-04  (L. Brodeau, A.M. Treguier) additions:  
    88   !!                            -  new bulk routine for efficiency 
    99   !!                            -  WINDS ARE NOW ASSUMED TO BE AT T POINTS in input files !!!! 
    1010   !!                            -  file names and file characteristics in namelist  
    1111   !!                            -  Implement reading of 6-hourly fields    
    12    !!                  !  06-06  (G. Madec) sbc rewritting 
     12   !!            3.0   !  06-06  (G. Madec) sbc rewritting 
    1313   !!---------------------------------------------------------------------- 
    1414 
    … …  
    6666   !!---------------------------------------------------------------------- 
    6767   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    68    !! $Header: $ 
     68   !! $ Id: $ 
    6969   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7070   !!---------------------------------------------------------------------- 
    … …  
    184184      ENDIF 
    185185 
    186       CALL fld_read( kt, nn_fsbc, sf )                ! Read input fields and provides the 
    187       !                                               ! input fields at the current time-step 
     186 
     187      CALL fld_read( kt, nn_fsbc, sf )                ! input fields provided at the current time-step 
    188188 
    189189      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    190  
    191           CALL blk_oce_core( sst_m, ssu_m, ssv_m )        ! set the ocean surface fluxes 
    192  
     190          CALL blk_oce_core( sst_m, ssu_m, ssv_m )    ! compute the surface ocean fluxes using CLIO bulk formulea 
    193191      ENDIF 
    194192      !                                               ! using CORE bulk formulea 
    … …  
    208206      !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2) 
    209207      !!              - vtau    : j-component of the stress at V-point  (N/m2) 
    210       !!              - qsr_oce : Solar heat flux over the ocean        (W/m2) 
    211       !!              - qns_oce : Non Solar heat flux over the ocean    (W/m2) 
     208      !!              - qsr    : Solar heat flux over the ocean        (W/m2) 
     209      !!              - qns    : Non Solar heat flux over the ocean    (W/m2) 
    212210      !!              - evap    : Evaporation over the ocean            (kg/m2/s) 
    213211      !!              - tprecip : Total precipitation                   (Kg/m2/s) 
    … …  
    334332            &          tab2d_2=vtau   , clinfo2=' vtau : ', mask2=vmask ) 
    335333         CALL prt_ctl( tab2d_1=zwind_speed_t, clinfo1=' blk_oce_core: zwind_speed_t : ') 
     334         CALL prt_ctl( tab2d_1=zst    , clinfo1=' blk_oce_core: zst    : ') 
    336335      ENDIF 
    337336        
    … …  
    354353      &                      p_qla , p_dqns, p_dqla,          & 
    355354      &                      p_tpr , p_spr ,                  & 
    356       &                      p_fr1 , p_fr2 )  
     355      &                      p_fr1 , p_fr2 , cd_grid )  
    357356      !!--------------------------------------------------------------------- 
    358357      !!                     ***  ROUTINE blk_ice_core  *** 
    … …  
    367366      !! caution : the net upward water flux has with mm/day unit 
    368367      !!--------------------------------------------------------------------- 
    369       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pst      ! ice surface temperature (>0, =rt0 over land)   [Kelvin] 
    370       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pui      ! ice surface velocity (i-component, I-point)    [m/s] 
    371       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pvi      ! ice surface velocity (j-component, I-point)    [m/s] 
    372       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)            [%] 
    373       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component)    [N/m2] 
    374       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component)    [N/m2] 
    375       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2] 
    376       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2] 
    377       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2] 
    378       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2] 
    379       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2] 
    380       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)         [Kg/m2/s] 
    381       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)         [Kg/m2/s] 
    382       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [%] 
    383       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [%] 
    384       !! 
    385       INTEGER  ::   ji, jj                    ! dummy loop indices 
    386       REAL(wp) ::   zst3 
    387       REAL(wp) ::   zcoef_wnorm, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
    388       REAL(wp) ::   zcoef_frca                       ! fractional cloud amount 
    389       REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f      ! relative wind module and components at F-point 
    390       REAL(wp) ::             zwndi_t , zwndj_t      ! relative wind components at T-point 
    391       REAL(wp), DIMENSION(jpi,jpj) ::   z_wnds_t     ! wind speed ( = | U10m - U_ice | ) at T-point 
    392       REAL(wp), DIMENSION(jpi,jpj) ::   z_qlw        ! long wave heat flux over ice 
    393       REAL(wp), DIMENSION(jpi,jpj) ::   z_qsb        ! sensible  heat flux over ice 
    394       REAL(wp), DIMENSION(jpi,jpj) ::   z_dqlw       ! sensible  heat flux over ice 
    395       REAL(wp), DIMENSION(jpi,jpj) ::   z_dqsb       ! sensible  heat flux over ice 
     368      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin] 
     369      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
     370      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
     371      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%] 
     372      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
     373      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
     374      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2] 
     375      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2] 
     376      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2] 
     377      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2] 
     378      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2] 
     379      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s] 
     380      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s] 
     381      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%] 
     382      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%] 
     383      CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! ice grid ( C or B-grid) 
     384      !! 
     385      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     386      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
     387      REAL(wp) ::   zst2, zst3 
     388      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
     389      REAL(wp) ::   zcoef_frca                                   ! fractional cloud amount 
     390      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
     391      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
     392      REAL(wp), DIMENSION(jpi,jpj) ::   z_wnds_t                 ! wind speed ( = | U10m - U_ice | ) at T-point 
     393      REAL(wp), DIMENSION(jpi,jpj,SIZE(pst,3)) ::   z_qlw        ! long wave heat flux over ice 
     394      REAL(wp), DIMENSION(jpi,jpj,SIZE(pst,3)) ::   z_qsb        ! sensible  heat flux over ice 
     395      REAL(wp), DIMENSION(jpi,jpj,SIZE(pst,3)) ::   z_dqlw       ! sensible  heat flux over ice 
     396      REAL(wp), DIMENSION(jpi,jpj,SIZE(pst,3)) ::   z_dqsb       ! sensible  heat flux over ice 
    396397      !!--------------------------------------------------------------------- 
     398 
     399      ijpl  = SIZE( pst, 3 )                 ! number of ice categories 
    397400 
    398401      ! local scalars ( place there for vector optimisation purposes) 
    399402      zcoef_wnorm = rhoa * Cice 
     403      zcoef_wnorm2 = rhoa * Cice * 0.5 
    400404      zcoef_dqlw = 4.0 * 0.95 * Stef 
    401405      zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8) 
    … …  
    410414 
    411415      ! ----------------------------------------------------------------------------- ! 
    412       !    Wind components and module relative to the moving ocean at I and T-point   ! 
    413       ! ----------------------------------------------------------------------------- ! 
    414       ! ... components ( U10m - U_oce ) at I-point (F-point with sea-ice indexation) (unmasked) 
    415       !     and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
     416      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   ! 
     417      ! ----------------------------------------------------------------------------- ! 
     418      SELECT CASE( cd_grid ) 
     419      CASE( 'B' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
     420         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
    416421#if defined key_vectopt_loop 
    417422!CDIR COLLAPSE 
    418423#endif 
    419424!CDIR NOVERRCHK 
    420       DO jj = 2, jpjm1 
    421          DO ji = fs_2, fs_jpim1 
    422             ! ... scalar wind at I-point (fld being at T-point) 
    423             zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ) + sf(jp_wndi)%fnow(ji  ,jj  )   & 
    424                &              + sf(jp_wndi)%fnow(ji-1,jj-1) + sf(jp_wndi)%fnow(ji  ,jj-1)  ) - pui(ji,jj) 
    425             zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ) + sf(jp_wndj)%fnow(ji  ,jj  )   & 
    426                &              + sf(jp_wndj)%fnow(ji-1,jj-1) + sf(jp_wndj)%fnow(ji  ,jj-1)  ) - pvi(ji,jj) 
    427             zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    428             ! ... ice stress at I-point 
    429             p_taui(ji,jj) = zwnorm_f * zwndi_f 
    430             p_tauj(ji,jj) = zwnorm_f * zwndj_f 
    431             ! ... scalar wind at T-point (fld being at T-point) 
    432             zwndi_t = sf(jp_wndi)%fnow(ji,jj) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
    433                &                                        + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
    434             zwndj_t = sf(jp_wndj)%fnow(ji,jj) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
    435                &                                        + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
    436             z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     425         DO jj = 2, jpjm1 
     426            DO ji = fs_2, fs_jpim1 
     427               ! ... scalar wind at I-point (fld being at T-point) 
     428               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ) + sf(jp_wndi)%fnow(ji  ,jj  )   & 
     429                  &              + sf(jp_wndi)%fnow(ji-1,jj-1) + sf(jp_wndi)%fnow(ji  ,jj-1)  ) - pui(ji,jj) 
     430               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ) + sf(jp_wndj)%fnow(ji  ,jj  )   & 
     431                  &              + sf(jp_wndj)%fnow(ji-1,jj-1) + sf(jp_wndj)%fnow(ji  ,jj-1)  ) - pvi(ji,jj) 
     432               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
     433               ! ... ice stress at I-point 
     434               p_taui(ji,jj) = zwnorm_f * zwndi_f 
     435               p_tauj(ji,jj) = zwnorm_f * zwndj_f 
     436               ! ... scalar wind at T-point (fld being at T-point) 
     437               zwndi_t = sf(jp_wndi)%fnow(ji,jj) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
     438                  &                                        + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
     439               zwndj_t = sf(jp_wndj)%fnow(ji,jj) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
     440                  &                                        + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
     441               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     442            END DO 
    437443         END DO 
     444         CALL lbc_lnk( p_taui  , 'I', -1. ) 
     445         CALL lbc_lnk( p_tauj  , 'I', -1. ) 
     446         CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
     447         ! 
     448      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
     449#if defined key_vectopt_loop 
     450!CDIR COLLAPSE 
     451#endif 
     452         DO jj = 2, jpj 
     453            DO ji = fs_2, jpi   ! vect. opt. 
     454               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
     455               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
     456               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     457            END DO 
     458         END DO 
     459#if defined key_vectopt_loop 
     460!CDIR COLLAPSE 
     461#endif 
     462         DO jj = 2, jpjm1 
     463            DO ji = fs_2, fs_jpim1   ! vect. opt. 
     464               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj) + z_wnds_t(ji,jj) )                          & 
     465                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj) + sf(jp_wndi)%fnow(ji,jj) ) - pui(ji,jj) ) 
     466               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1) + z_wnds_t(ji,jj) )                          & 
     467                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1) + sf(jp_wndj)%fnow(ji,jj) ) - pvi(ji,jj) ) 
     468            END DO 
     469         END DO 
     470         CALL lbc_lnk( p_taui  , 'U', -1. ) 
     471         CALL lbc_lnk( p_tauj  , 'V', -1. ) 
     472         CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
     473         ! 
     474      END SELECT 
     475 
     476      !                                     ! ========================== ! 
     477      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     478         !                                  ! ========================== ! 
     479!CDIR NOVERRCHK 
     480!CDIR COLLAPSE 
     481         DO jj = 1 , jpj 
     482!CDIR NOVERRCHK 
     483            DO ji = 1, jpi 
     484               ! ----------------------------! 
     485               !      I   Radiative FLUXES   ! 
     486               ! ----------------------------! 
     487               zst2 = pst(ji,jj,jl) * pst(ji,jj,jl) 
     488               zst3 = pst(ji,jj,jl) * zst2 
     489               ! Short Wave (sw) 
     490               p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj) * tmask(ji,jj,1) 
     491               ! Long  Wave (lw) 
     492               z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj)       &                          
     493                  &                   - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1) 
     494               ! lw sensitivity 
     495               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
     496 
     497               ! ----------------------------! 
     498               !     II    Turbulent FLUXES  ! 
     499               ! ----------------------------! 
     500 
     501               ! ... turbulent heat fluxes 
     502               ! Sensible Heat 
     503               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj) ) 
     504               ! Latent Heat 
     505               p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
     506                  &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj)  ) ) 
     507               ! Latent heat sensitivity for ice (Dqla/Dt) 
     508               p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     509               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
     510               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
     511 
     512               ! ----------------------------! 
     513               !     III    Total FLUXES     ! 
     514               ! ----------------------------! 
     515               ! Downward Non Solar flux 
     516               p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)       
     517               ! Total non solar heat flux sensitivity for ice 
     518               p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )     
     519            END DO 
     520            ! 
     521         END DO 
     522         ! 
    438523      END DO 
    439       CALL lbc_lnk( p_taui  , 'I', -1. ) 
    440       CALL lbc_lnk( p_tauj  , 'I', -1. ) 
    441       CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
    442  
    443       ! ----------------------------------------------------------------------------- ! 
    444       !      I   Radiative FLUXES                                                     ! 
    445       ! ----------------------------------------------------------------------------- ! 
    446 !CDIR COLLAPSE 
    447       DO jj = 1, jpj 
    448          DO ji = 1, jpi 
    449             zst3 = pst(ji,jj) * pst(ji,jj) * pst(ji,jj) 
    450             p_qsr(ji,jj) = ( 1. - palb(ji,jj) ) * sf(jp_qsr)%fnow(ji,jj) * tmask(ji,jj,1)     ! Short Wave (sw) 
    451             z_qlw(ji,jj) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj)       &                           ! Long  Wave (lw) 
    452                &                   - Stef * pst(ji,jj) * zst3  ) * tmask(ji,jj,1) 
    453             z_dqlw(ji,jj) = zcoef_dqlw * zst3                                                      ! lw sensitivity 
    454          END DO 
    455       END DO 
    456  
    457       ! ----------------------------------------------------------------------------- ! 
    458       !     II    Turbulent FLUXES                                                    ! 
    459       ! ----------------------------------------------------------------------------- ! 
    460  
    461       ! ... turbulent heat fluxes 
    462 !CDIR COLLAPSE 
    463       z_qsb(:,:) = rhoa * cpa * Cice * z_wnds_t(:,:) * ( pst(:,:) - sf(jp_tair)%fnow(:,:) )   ! Sensible Heat 
    464 !CDIR NOVERRCHK 
    465 !CDIR COLLAPSE 
    466       p_qla(:,:) = MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(:,:)   &                           ! Latent Heat 
    467          &                    * (  11637800. * EXP( -5897.8 / pst(:,:) ) / rhoa - sf(jp_humi)%fnow(:,:)  ) ) 
    468        
    469       ! Latent heat sensitivity for ice (Dqla/Dt) 
    470 !CDIR NOVERRCHK 
    471 !CDIR COLLAPSE 
    472       p_dqla(:,:) = zcoef_dqla * z_wnds_t(:,:) / ( pst(:,:) * pst(:,:) ) * EXP( -5897.8 / pst(:,:) ) 
    473         
    474       ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    475 !CDIR COLLAPSE 
    476       z_dqsb(:,:) = zcoef_dqsb * z_wnds_t(:,:) 
    477  
    478       ! ----------------------------------------------------------------------------- ! 
    479       !     III    Total FLUXES                                                       ! 
    480       ! ----------------------------------------------------------------------------- ! 
    481       
    482 !CDIR COLLAPSE 
    483       p_qns (:,:) =     z_qlw (:,:) - z_qsb (:,:) - p_qla (:,:)      ! Downward Non Solar flux 
    484 !CDIR COLLAPSE 
    485       p_dqns(:,:) = - ( z_dqlw(:,:) + z_dqsb(:,:) + p_dqla(:,:) )    ! Total non solar heat flux sensitivity for ice 
    486         
    487         
     524      ! 
    488525      !-------------------------------------------------------------------- 
    489526      ! FRACTIONs of net shortwave radiation which is not absorbed in the 
    … …  
    502539      ! 
    503540      IF(ln_ctl) THEN 
    504          CALL prt_ctl(tab2d_1=p_qla   , clinfo1=' blk_ice_core: p_qla  : ', tab2d_2=z_qsb   , clinfo2=' z_qsb    : ') 
    505          CALL prt_ctl(tab2d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw  : ', tab2d_2=p_dqla  , clinfo2=' p_dqla   : ') 
    506          CALL prt_ctl(tab2d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb : ', tab2d_2=z_dqlw  , clinfo2=' z_dqlw   : ') 
    507          CALL prt_ctl(tab2d_1=p_tpr   , clinfo1=' blk_ice_core: p_tpr  : ', tab2d_2=p_spr   , clinfo2=' p_spr    : ') 
    508          CALL prt_ctl(tab2d_1=p_dqns  , clinfo1=' blk_ice_core: p_dqns : ', tab2d_2=z_wnds_t, clinfo2=' z_wnds_t : ') 
    509          CALL prt_ctl(tab2d_1=p_taui  , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj  , clinfo2=' p_tauj   : ') 
     541         CALL prt_ctl(tab3d_1=p_qla   , clinfo1=' blk_ice_core: p_qla  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb  : ', kdim=ijpl) 
     542         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw  : ', tab3d_2=p_dqla  , clinfo2=' p_dqla : ', kdim=ijpl) 
     543         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw : ', kdim=ijpl) 
     544         CALL prt_ctl(tab3d_1=p_dqns  , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr   , clinfo2=' p_qsr  : ', kdim=ijpl) 
     545         CALL prt_ctl(tab3d_1=pst     , clinfo1=' blk_ice_core: pst    : ', tab3d_2=p_qns   , clinfo2=' p_qns  : ', kdim=ijpl) 
     546         CALL prt_ctl(tab2d_1=p_tpr   , clinfo1=' blk_ice_core: p_tpr  : ', tab2d_2=p_spr   , clinfo2=' p_spr  : ') 
     547         CALL prt_ctl(tab2d_1=p_taui  , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj  , clinfo2=' p_tauj : ') 
     548         CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ') 
    510549      ENDIF 
    511550 
    … …  
    801840    END FUNCTION psi_h 
    802841   
    803    
    804842   !!====================================================================== 
    805843END MODULE sbcblk_core 

  • branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r882 r886  
    5252   PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90 
    5353    
     54   CHARACTER(len=1) ::   cl_grid = 'B'     ! type of grid used in ice dynamics 
     55 
    5456   !! * Substitutions 
    5557#  include "domzgr_substitute.h90" 
    … …  
    8789      !! 
    8890      INTEGER  ::   ji, jj   ! dummy loop indices 
    89       REAL(wp), DIMENSION(jpi,jpj) ::   alb_oce_os   ! albedo of the ocean under overcast sky 
    90       REAL(wp), DIMENSION(jpi,jpj) ::   alb_oce_cs   ! albedo of the ocean under clear sky 
    91       REAL(wp), DIMENSION(jpi,jpj) ::   alb_ice_os   ! albedo of the ice under overcast sky 
    92       REAL(wp), DIMENSION(jpi,jpj) ::   alb_ice_cs   ! albedo of ice under clear sky 
     91      REAL(wp), DIMENSION(jpi,jpj,1) ::   alb_ice_os   ! albedo of the ice under overcast sky 
     92      REAL(wp), DIMENSION(jpi,jpj,1) ::   alb_ice_cs   ! albedo of ice under clear sky 
     93      REAL(wp), DIMENSION(jpi,jpj,1) ::   zsist        ! surface ice temperature (K) 
     94      REAL(wp), DIMENSION(jpi,jpj,1) ::   zhicif       ! ice thickness 
     95      REAL(wp), DIMENSION(jpi,jpj,1) ::   zhsnif       ! snow thickness 
     96      REAL(wp), DIMENSION(jpi,jpj,1) ::   zqns_ice     ! non solar sea-ice heat flux 
     97      REAL(wp), DIMENSION(jpi,jpj,1) ::   zqsr_ice     !     solar sea-ice heat flux 
     98      REAL(wp), DIMENSION(jpi,jpj,1) ::   zqla_ice     ! ice latent heat flux 
     99      REAL(wp), DIMENSION(jpi,jpj,1) ::   zdqns_ice    ! sensitivity ice net heat flux 
     100      REAL(wp), DIMENSION(jpi,jpj,1) ::   zdqla_ice    ! sensitivity ice latent heat flux 
    93101      !!---------------------------------------------------------------------- 
    94102 
    … …  
    104112      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    105113         ! 
    106          ! ... mean surface ocean current at I-point (F-point with sea-ice indexation) 
     114         ! ... mean surface ocean current at ice dynamics point 
     115         !     B-grid dynamics :  I-point (F-point with sea-ice indexation) 
    107116         DO jj = 2, jpj 
    108117            DO ji = fs_2, jpi   ! vector opt. 
    … …  
    117126         tfu(:,:) = tfreez( sss_m ) +  rt0  
    118127 
    119          ! ... ice and ocean albedo 
    120          CALL blk_albedo( alb_ice_os , alb_oce_os , alb_ice_cs , alb_oce_cs ) 
     128         zsist (:,:,1) = sist (:,:) 
     129         zhicif(:,:,1) = hicif(:,:)   ;   zhsnif(:,:,1) = hsnif(:,:) 
     130 
     131         ! ... ice albedo 
     132         CALL albedo_ice( zsist, zhicif, zhsnif, alb_ice_cs, alb_ice_os ) 
    121133 
    122134         ! ... Sea-ice surface boundary conditions output from bulk formulae : 
    … …  
    135147         SELECT CASE( kblk ) 
    136148         CASE( 3 )           ! CLIO bulk formulation 
    137             CALL blk_ice_clio( sist     , ui_ice   , vi_ice   , alb_ice_cs, alb_ice_os,            & 
    138                &                                     utaui_ice, vtaui_ice , qns_ice   , qsr_ice,   & 
    139                &                                     qla_ice  , dqns_ice  , dqla_ice  ,            & 
    140                &                                     tprecip  , sprecip   ,                        & 
    141                &                                     fr1_i0   , fr2_i0    , 'B'  ) 
     149            CALL blk_ice_clio( zsist , ui_ice , vi_ice   , alb_ice_cs , alb_ice_os ,             & 
     150               &                               utaui_ice , vtaui_ice  , zqns_ice   , zqsr_ice,   & 
     151               &                               zqla_ice  , zdqns_ice  , zdqla_ice  ,             & 
     152               &                               tprecip   , sprecip    ,                          & 
     153               &                               fr1_i0    , fr2_i0     , cl_grid  ) 
    142154         CASE( 4 )           ! CORE bulk formulation 
    143             CALL blk_ice_core( sist     , ui_ice   , vi_ice   , alb_ice_cs,                      & 
    144                &                                     utaui_ice, vtaui_ice , qns_ice , qsr_ice,   & 
    145                &                                     qla_ice  , dqns_ice  , dqla_ice,            & 
    146                &                                     tprecip  , sprecip   ,                      & 
    147                &                                     fr1_i0   , fr2_i0  ) 
     155            CALL blk_ice_core( zsist , ui_ice , vi_ice   , alb_ice_cs ,                         & 
     156               &                               utaui_ice , vtaui_ice  , zqns_ice  , zqsr_ice,   & 
     157               &                               zqla_ice  , zdqns_ice  , zdqla_ice ,             & 
     158               &                               tprecip   , sprecip    ,                         & 
     159               &                               fr1_i0    , fr2_i0     , cl_grid) 
    148160         END SELECT 
     161 
     162         qsr_ice(:,:) = zqsr_ice(:,:,1) 
     163         qns_ice(:,:) = zqns_ice(:,:,1)   ;   dqns_ice(:,:) = zdqns_ice(:,:,1) 
     164         qla_ice(:,:) = zqla_ice(:,:,1)   ;   dqla_ice(:,:) = zdqla_ice(:,:,1) 
    149165 
    150166         IF(ln_ctl) THEN         ! print mean trends (used for debugging) 

  • branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcmod.F90

    r881 r886  
    2626   USE sbcblk_core     ! surface boundary condition: bulk formulation : CORE 
    2727   USE sbcice_if       ! surface boundary condition: ice-if sea-ice model 
     28   USE sbcice_lim      ! surface boundary condition: LIM 3.0 sea-ice model 
    2829   USE sbcice_lim_2    ! surface boundary condition: LIM 2.0 sea-ice model 
    2930   USE sbccpl          ! surface boundary condition: coupled florulation 
    … …  
    9697!!gmhere no overwrite, test all option via namelist change: require more incore memory 
    9798!!gm  IF( lk_sbc_cpl       ) THEN   ;   ln_cpl      = .TRUE.   ;   ELSE   ;   ln_cpl      = .FALSE.   ;   ENDIF 
    98       IF( lk_ice_lim       )            nn_ice      = 2 
     99      IF( lk_lim2 )            nn_ice      = 2 
     100      IF( lk_lim3 )            nn_ice      = 3 
    99101      IF( cp_cfg == 'gyre' ) THEN 
    100102          ln_ana      = .TRUE.    
    … …  
    229231         !                                                           ! (update heat and freshwater fluxes) 
    230232      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM 2.0 ice model 
     233         !                                                           ! (update heat and freshwater fluxes) 
     234      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM 3.0 ice model 
    231235      END SELECT                                                     ! (update all fluxes using bulk + LIM) 
    232236 

  • branches/dev_001_SBC/NEMO/OPA_SRC/ice_oce.F90

    r885 r886  
    4545      fcalving            !: Iceberg calving  
    4646# endif 
     47 
     48# if defined key_lim3 
     49   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: field exchanges with ice model to ocean 
     50      catm_ice       , &  !: cloud cover 
     51      tatm_ice       , &  !: air temperature 
     52      icethi              !: icethickness 
     53# endif 
    4754    
    4855   REAL(wp), PUBLIC ::   &  !: 

  • branches/dev_001_SBC/NEMO/OPA_SRC/lib_mpp.F90

    r717 r886  
    6060   PUBLIC  mynode, mpparent, mpp_isl, mpp_min, mpp_max, mpp_sum,  mpp_lbc_north 
    6161   PUBLIC  mpp_lbc_north_e, mpp_minloc, mpp_maxloc, mpp_lnk_3d, mpp_lnk_2d, mpp_lnk_3d_gather, mpp_lnk_2d_e, mpplnks 
    62    PUBLIC  mpprecv, mppsend, mppscatter, mppgather, mppobc, mpp_ini_north, mppstop, mppsync 
     62   PUBLIC  mpprecv, mppsend, mppscatter, mppgather, mppobc, mpp_ini_north, mppstop, mppsync, mpp_ini_ice, mpp_comm_free 
    6363#if defined key_oasis3 || defined key_oasis4 
    6464   PUBLIC  mppsize, mpprank 
    … …  
    113113      mpi_comm_opa ! opa local communicator 
    114114 
     115   ! variables used in case of sea-ice 
     116   INTEGER, PUBLIC ::  &       ! 
     117      ngrp_ice,        &       ! group ID for the ice processors (to compute rheology) 
     118      ncomm_ice,       &       ! communicator made by the processors with sea-ice 
     119      ndim_rank_ice,   &       ! number of 'ice' processors 
     120      n_ice_root               ! number (in the comm_ice) of proc 0 in the ice comm 
     121   INTEGER, DIMENSION(:), ALLOCATABLE ::   & 
     122      nrank_ice            ! dimension ndim_rank_north, number of the procs belonging to ncomm_north 
    115123   ! variables used in case of north fold condition in mpp_mpi with jpni > 1 
    116124   INTEGER ::      &       ! 
    … …  
    30853093 
    30863094 
    3087    SUBROUTINE mppmax_a_int( ktab, kdim ) 
     3095   SUBROUTINE mppmax_a_int( ktab, kdim, kcom ) 
    30883096      !!---------------------------------------------------------------------- 
    30893097      !!                  ***  routine mppmax_a_int  *** 
    … …  
    30953103      INTEGER , INTENT( in  )                  ::   kdim        ! size of array 
    30963104      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array 
     3105      INTEGER , INTENT(in)   , OPTIONAL        ::   kcom   
    30973106   
    30983107#if defined key_mpp_shmem 
    … …  
    31263135      !! * Local variables   (MPI version) 
    31273136      INTEGER :: ierror 
     3137      INTEGER :: localcomm 
    31283138      INTEGER, DIMENSION(kdim) ::   iwork 
     3139 
     3140      localcomm = mpi_comm_opa 
     3141      IF( PRESENT(kcom) ) localcomm = kcom 
    31293142   
    31303143      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   & 
    3131            &                mpi_max, mpi_comm_opa, ierror ) 
     3144           &                mpi_max, localcomm, ierror ) 
    31323145   
    31333146      ktab(:) = iwork(:) 
    … …  
    31373150 
    31383151 
    3139    SUBROUTINE mppmax_int( ktab ) 
     3152   SUBROUTINE mppmax_int( ktab, kcom ) 
    31403153      !!---------------------------------------------------------------------- 
    31413154      !!                  ***  routine mppmax_int  *** 
    … …  
    31483161      !! * Arguments 
    31493162      INTEGER, INTENT(inout) ::   ktab      ! ??? 
     3163      INTEGER, INTENT(in), OPTIONAL ::   kcom      ! ??? 
    31503164   
    31513165      !! * Local declarations 
    … …  
    31753189      !! * Local variables   (MPI version) 
    31763190      INTEGER ::  ierror, iwork 
    3177    
     3191      INTEGER :: localcomm 
     3192 
     3193      localcomm = mpi_comm_opa  
     3194      IF( PRESENT(kcom) ) localcomm = kcom 
     3195 
    31783196      CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   & 
    3179            &              ,mpi_max,mpi_comm_opa,ierror) 
     3197           &              ,mpi_max,localcomm,ierror) 
    31803198   
    31813199      ktab = iwork 
    … …  
    31853203 
    31863204 
    3187    SUBROUTINE mppmin_a_int( ktab, kdim ) 
     3205   SUBROUTINE mppmin_a_int( ktab, kdim, kcom ) 
    31883206      !!---------------------------------------------------------------------- 
    31893207      !!                  ***  routine mppmin_a_int  *** 
    … …  
    31953213      INTEGER , INTENT( in  )                  ::   kdim        ! size of array 
    31963214      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array 
     3215      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array 
    31973216   
    31983217#if defined key_mpp_shmem 
    … …  
    32263245      !! * Local variables   (MPI version) 
    32273246      INTEGER :: ierror 
     3247      INTEGER :: localcomm 
    32283248      INTEGER, DIMENSION(kdim) ::   iwork 
    32293249   
     3250      localcomm = mpi_comm_opa 
     3251      IF( PRESENT(kcom) ) localcomm = kcom 
     3252 
    32303253      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   & 
    3231            &                mpi_min, mpi_comm_opa, ierror ) 
     3254           &                mpi_min, localcomm, ierror ) 
    32323255   
    32333256      ktab(:) = iwork(:) 
    … …  
    35213544 
    35223545 
    3523   SUBROUTINE mppmax_a_real( ptab, kdim ) 
     3546  SUBROUTINE mppmax_a_real( ptab, kdim, kcom ) 
    35243547    !!---------------------------------------------------------------------- 
    35253548    !!                 ***  routine mppmax_a_real  *** 
    … …  
    35313554    INTEGER , INTENT( in  )                  ::   kdim 
    35323555    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab 
     3556    INTEGER , INTENT( in  ), OPTIONAL        ::   kcom 
    35333557 
    35343558#if defined key_mpp_shmem 
    … …  
    35633587    !! * Local variables   (MPI version) 
    35643588    INTEGER :: ierror 
     3589    INTEGER :: localcomm 
    35653590    REAL(wp), DIMENSION(kdim) ::  zwork 
    35663591 
     3592    localcomm = mpi_comm_opa 
     3593    IF( PRESENT(kcom) ) localcomm = kcom 
     3594 
    35673595    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   & 
    3568          ,mpi_max,mpi_comm_opa,ierror) 
     3596         ,mpi_max,localcomm,ierror) 
    35693597    ptab(:) = zwork(:) 
    35703598 
    … …  
    35743602 
    35753603 
    3576   SUBROUTINE mppmax_real( ptab ) 
     3604  SUBROUTINE mppmax_real( ptab, kcom ) 
    35773605    !!---------------------------------------------------------------------- 
    35783606    !!                  ***  routine mppmax_real  *** 
    … …  
    35833611    !! * Arguments 
    35843612    REAL(wp), INTENT(inout) ::   ptab      ! ??? 
     3613    INTEGER , INTENT( in  ), OPTIONAL ::   kcom      ! ??? 
    35853614 
    35863615#if defined key_mpp_shmem 
    … …  
    36073636    !! * Local variables   (MPI version) 
    36083637    INTEGER  ::   ierror 
     3638    INTEGER  ::   localcomm 
    36093639    REAL(wp) ::   zwork 
    36103640 
     3641    localcomm = mpi_comm_opa  
     3642    IF( PRESENT(kcom) ) localcomm = kcom 
     3643 
    36113644    CALL mpi_allreduce( ptab, zwork  , 1             , mpi_double_precision,   & 
    3612        &                      mpi_max, mpi_comm_opa, ierror     ) 
     3645       &                      mpi_max, localcomm, ierror     ) 
    36133646    ptab = zwork 
    36143647 
    … …  
    36183651 
    36193652 
    3620   SUBROUTINE mppmin_a_real( ptab, kdim ) 
     3653  SUBROUTINE mppmin_a_real( ptab, kdim, kcom ) 
    36213654    !!---------------------------------------------------------------------- 
    36223655    !!                 ***  routine mppmin_a_real  *** 
    … …  
    36283661    INTEGER , INTENT( in  )                  ::   kdim 
    36293662    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab 
     3663    INTEGER , INTENT( in  ), OPTIONAL        ::   kcom 
    36303664 
    36313665#if defined key_mpp_shmem 
    … …  
    36603694    !! * Local variables   (MPI version) 
    36613695    INTEGER :: ierror 
     3696    INTEGER :: localcomm  
    36623697    REAL(wp), DIMENSION(kdim) ::   zwork 
    36633698 
     3699    localcomm = mpi_comm_opa  
     3700    IF( PRESENT(kcom) ) localcomm = kcom 
     3701 
    36643702    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   & 
    3665          ,mpi_min,mpi_comm_opa,ierror) 
     3703         ,mpi_min,localcomm,ierror) 
    36663704    ptab(:) = zwork(:) 
    36673705 
    … …  
    36713709 
    36723710 
    3673   SUBROUTINE mppmin_real( ptab ) 
     3711  SUBROUTINE mppmin_real( ptab, kcom ) 
    36743712    !!---------------------------------------------------------------------- 
    36753713    !!                  ***  routine mppmin_real  *** 
    … …  
    36813719    !! * Arguments 
    36823720    REAL(wp), INTENT( inout ) ::   ptab        !  
     3721    INTEGER , INTENT(  in   ), OPTIONAL :: kcom 
    36833722 
    36843723#if defined key_mpp_shmem 
    … …  
    37063745    INTEGER  ::   ierror 
    37073746    REAL(wp) ::   zwork 
     3747    INTEGER :: localcomm 
     3748 
     3749    localcomm = mpi_comm_opa  
     3750    IF( PRESENT(kcom) ) localcomm = kcom 
    37083751 
    37093752    CALL mpi_allreduce( ptab, zwork, 1,mpi_double_precision   & 
    3710          &               ,mpi_min,mpi_comm_opa,ierror) 
     3753         &               ,mpi_min,localcomm,ierror) 
    37113754    ptab = zwork 
    37123755 
    … …  
    37163759 
    37173760 
    3718   SUBROUTINE mppsum_a_real( ptab, kdim ) 
     3761  SUBROUTINE mppsum_a_real( ptab, kdim, kcom ) 
    37193762    !!---------------------------------------------------------------------- 
    37203763    !!                  ***  routine mppsum_a_real  *** 
    … …  
    37263769    INTEGER , INTENT( in )                     ::   kdim      ! size of ptab 
    37273770    REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array 
     3771    INTEGER , INTENT( in ), OPTIONAL           :: kcom 
    37283772 
    37293773#if defined key_mpp_shmem 
    … …  
    37583802    !! * Local variables   (MPI version) 
    37593803    INTEGER                   ::   ierror    ! temporary integer 
     3804    INTEGER                   ::   localcomm  
    37603805    REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace  
     3806     
     3807 
     3808    localcomm = mpi_comm_opa  
     3809    IF( PRESENT(kcom) ) localcomm = kcom 
    37613810 
    37623811    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   & 
    3763          &              ,mpi_sum,mpi_comm_opa,ierror) 
     3812         &              ,mpi_sum,localcomm,ierror) 
    37643813    ptab(:) = zwork(:) 
    37653814 
    … …  
    37693818 
    37703819 
    3771   SUBROUTINE mppsum_real( ptab ) 
     3820  SUBROUTINE mppsum_real( ptab, kcom ) 
    37723821    !!---------------------------------------------------------------------- 
    37733822    !!                  ***  routine mppsum_real  *** 
    … …  
    37783827    !!----------------------------------------------------------------------- 
    37793828    REAL(wp), INTENT(inout) ::   ptab        ! input scalar 
     3829    INTEGER , INTENT( in  ), OPTIONAL :: kcom 
    37803830 
    37813831#if defined key_mpp_shmem 
    … …  
    38023852    !! * Local variables   (MPI version) 
    38033853    INTEGER  ::   ierror 
     3854    INTEGER  ::   localcomm  
    38043855    REAL(wp) ::   zwork 
    38053856 
    3806     CALL mpi_allreduce(ptab, zwork, 1,mpi_double_precision   & 
    3807          &              ,mpi_sum,mpi_comm_opa,ierror) 
     3857   localcomm = mpi_comm_opa  
     3858   IF( PRESENT(kcom) ) localcomm = kcom 
     3859  
     3860   CALL mpi_allreduce(ptab, zwork, 1,mpi_double_precision   & 
     3861         &              ,mpi_sum,localcomm,ierror) 
    38083862    ptab = zwork 
    38093863 
    … …  
    43054359  END SUBROUTINE mppobc 
    43064360 
     4361  SUBROUTINE mpp_comm_free( kcom) 
     4362 
     4363     INTEGER, INTENT(in) :: kcom 
     4364     INTEGER :: ierr 
     4365 
     4366     CALL MPI_COMM_FREE(kcom, ierr) 
     4367 
     4368  END SUBROUTINE mpp_comm_free 
     4369 
     4370 
     4371  SUBROUTINE mpp_ini_ice(pindic) 
     4372    !!---------------------------------------------------------------------- 
     4373    !!               ***  routine mpp_ini_ice  *** 
     4374    !! 
     4375    !! ** Purpose :   Initialize special communicator for ice areas 
     4376    !!      condition together with global variables needed in the ddmpp folding 
     4377    !! 
     4378    !! ** Method  : - Look for ice processors in ice routines 
     4379    !!              - Put their number in nrank_ice 
     4380    !!              - Create groups for the world processors and the ice processors 
     4381    !!              - Create a communicator for ice processors 
     4382    !! 
     4383    !! ** output 
     4384    !!      njmppmax = njmpp for northern procs 
     4385    !!      ndim_rank_ice = number of processors in the northern line 
     4386    !!      nrank_north (ndim_rank_north) = number  of the northern procs. 
     4387    !!      ngrp_world = group ID for the world processors 
     4388    !!      ngrp_ice = group ID for the ice processors 
     4389    !!      ncomm_ice = communicator for the ice procs. 
     4390    !!      n_ice_root = number (in the world) of proc 0 in the ice comm. 
     4391    !! 
     4392    !! History : 
     4393    !!        !  03-09 (J.M. Molines, MPI only ) 
     4394    !!---------------------------------------------------------------------- 
     4395#ifdef key_mpp_shmem 
     4396    CALL ctl_stop( ' mpp_ini_ice not available in SHMEM' ) 
     4397# elif key_mpp_mpi 
     4398    INTEGER, INTENT(in) :: pindic 
     4399    INTEGER :: ierr 
     4400    INTEGER :: jproc 
     4401    INTEGER :: ii,ji 
     4402    INTEGER, DIMENSION(jpnij) :: kice 
     4403    INTEGER, DIMENSION(jpnij) :: zwork 
     4404    INTEGER :: zrank 
     4405    !!---------------------------------------------------------------------- 
     4406 
     4407    ! Look for how many procs with sea-ice 
     4408    ! 
     4409    kice = 0 
     4410    DO jproc=1,jpnij 
     4411       IF(jproc == narea .AND. pindic .GT. 0) THEN 
     4412          kice(jproc) = 1     
     4413       ENDIF         
     4414    END DO 
     4415 
     4416    zwork = 0 
     4417    CALL MPI_ALLREDUCE( kice, zwork,jpnij, mpi_integer,   & 
     4418                       mpi_sum, mpi_comm_opa, ierr ) 
     4419    ndim_rank_ice = sum(zwork)           
     4420 
     4421    ! Allocate the right size to nrank_north 
     4422    IF(ALLOCATED(nrank_ice)) DEALLOCATE(nrank_ice) 
     4423    ALLOCATE(nrank_ice(ndim_rank_ice)) 
     4424 
     4425    ii = 0      
     4426    nrank_ice = 0 
     4427    DO jproc=1,jpnij 
     4428       IF(zwork(jproc) == 1) THEN 
     4429          ii = ii + 1 
     4430          nrank_ice(ii) = jproc -1  
     4431       ENDIF         
     4432    END DO 
     4433 
     4434    ! Create the world group 
     4435    CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_world,ierr) 
     4436 
     4437    ! Create the ice group from the world group 
     4438    CALL MPI_GROUP_INCL(ngrp_world,ndim_rank_ice,nrank_ice,ngrp_ice,ierr) 
     4439 
     4440    ! Create the ice communicator , ie the pool of procs with sea-ice 
     4441    CALL MPI_COMM_CREATE(mpi_comm_opa,ngrp_ice,ncomm_ice,ierr) 
     4442 
     4443    ! Find proc number in the world of proc 0 in the north 
     4444    CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr) 
     4445#endif 
     4446 
     4447  END SUBROUTINE mpp_ini_ice 
     4448 
    43074449 
    43084450  SUBROUTINE mpp_ini_north 
    … …  
    52535395 
    52545396   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag 
     5397   INTEGER :: ncomm_ice 
    52555398 
    52565399CONTAINS 
    … …  
    52645407   END SUBROUTINE mppsync 
    52655408 
    5266    SUBROUTINE mpp_sum_as( parr, kdim )      ! Dummy routine 
     5409   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine 
    52675410      REAL   , DIMENSION(:) :: parr 
    52685411      INTEGER               :: kdim 
    5269       WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1) 
     5412      INTEGER, OPTIONAL     :: kcom  
     5413      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom 
    52705414   END SUBROUTINE mpp_sum_as 
    52715415 
    5272    SUBROUTINE mpp_sum_a2s( parr, kdim )      ! Dummy routine 
     5416   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine 
    52735417      REAL   , DIMENSION(:,:) :: parr 
    52745418      INTEGER               :: kdim 
    5275       WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1) 
     5419      INTEGER, OPTIONAL     :: kcom  
     5420      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom 
    52765421   END SUBROUTINE mpp_sum_a2s 
    52775422 
    5278    SUBROUTINE mpp_sum_ai( karr, kdim )      ! Dummy routine 
     5423   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine 
    52795424      INTEGER, DIMENSION(:) :: karr 
    52805425      INTEGER               :: kdim 
    5281       WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1) 
     5426      INTEGER, OPTIONAL     :: kcom  
     5427      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom 
    52825428   END SUBROUTINE mpp_sum_ai 
    52835429 
    5284    SUBROUTINE mpp_sum_s( psca )            ! Dummy routine 
     5430   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine 
    52855431      REAL                  :: psca 
    5286       WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca 
     5432      INTEGER, OPTIONAL     :: kcom  
     5433      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom 
    52875434   END SUBROUTINE mpp_sum_s 
    52885435 
    5289    SUBROUTINE mpp_sum_i( kint )            ! Dummy routine 
     5436   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine 
    52905437      integer               :: kint 
    5291       WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint 
     5438      INTEGER, OPTIONAL     :: kcom  
     5439      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom 
    52925440   END SUBROUTINE mpp_sum_i 
    52935441 
    5294    SUBROUTINE mppmax_a_real( parr, kdim ) 
     5442   SUBROUTINE mppmax_a_real( parr, kdim, kcom ) 
    52955443      REAL   , DIMENSION(:) :: parr 
    52965444      INTEGER               :: kdim 
    5297       WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1) 
     5445      INTEGER, OPTIONAL     :: kcom  
     5446      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom 
    52985447   END SUBROUTINE mppmax_a_real 
    52995448 
    5300    SUBROUTINE mppmax_real( psca ) 
     5449   SUBROUTINE mppmax_real( psca, kcom ) 
    53015450      REAL                  :: psca 
    5302       WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca 
     5451      INTEGER, OPTIONAL     :: kcom  
     5452      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom 
    53035453   END SUBROUTINE mppmax_real 
    53045454 
    5305    SUBROUTINE mppmin_a_real( parr, kdim ) 
     5455   SUBROUTINE mppmin_a_real( parr, kdim, kcom ) 
    53065456      REAL   , DIMENSION(:) :: parr 
    53075457      INTEGER               :: kdim 
    5308       WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1) 
     5458      INTEGER, OPTIONAL     :: kcom  
     5459      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom 
    53095460   END SUBROUTINE mppmin_a_real 
    53105461 
    5311    SUBROUTINE mppmin_real( psca ) 
     5462   SUBROUTINE mppmin_real( psca, kcom ) 
    53125463      REAL                  :: psca 
    5313       WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca 
     5464      INTEGER, OPTIONAL     :: kcom  
     5465      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom 
    53145466   END SUBROUTINE mppmin_real 
    53155467 
    5316    SUBROUTINE mppmax_a_int( karr, kdim ) 
     5468   SUBROUTINE mppmax_a_int( karr, kdim ,kcom) 
    53175469      INTEGER, DIMENSION(:) :: karr 
    53185470      INTEGER               :: kdim 
    5319       WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1) 
     5471      INTEGER, OPTIONAL     :: kcom  
     5472      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom 
    53205473   END SUBROUTINE mppmax_a_int 
    53215474 
    5322    SUBROUTINE mppmax_int( kint ) 
     5475   SUBROUTINE mppmax_int( kint, kcom) 
    53235476      INTEGER               :: kint 
    5324       WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint 
     5477      INTEGER, OPTIONAL     :: kcom  
     5478      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom 
    53255479   END SUBROUTINE mppmax_int 
    53265480 
    5327    SUBROUTINE mppmin_a_int( karr, kdim ) 
     5481   SUBROUTINE mppmin_a_int( karr, kdim, kcom ) 
    53285482      INTEGER, DIMENSION(:) :: karr 
    53295483      INTEGER               :: kdim 
    5330       WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1) 
     5484      INTEGER, OPTIONAL     :: kcom  
     5485      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom 
    53315486   END SUBROUTINE mppmin_a_int 
    53325487 
    5333    SUBROUTINE mppmin_int( kint ) 
     5488   SUBROUTINE mppmin_int( kint, kcom ) 
    53345489      INTEGER               :: kint 
    5335       WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint 
     5490      INTEGER, OPTIONAL     :: kcom  
     5491      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 
    53365492   END SUBROUTINE mppmin_int 
    53375493 
    … …  
    54285584   END SUBROUTINE mppstop 
    54295585 
     5586   SUBROUTINE mpp_ini_ice(kcom) 
     5587      INTEGER :: kcom 
     5588      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?',kcom 
     5589   END SUBROUTINE mpp_ini_ice 
     5590 
     5591   SUBROUTINE mpp_comm_free(kcom) 
     5592      INTEGER :: kcom 
     5593      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?',kcom 
     5594   END SUBROUTINE mpp_comm_free 
     5595 
    54305596#endif 
    54315597   !!---------------------------------------------------------------------- 

  • branches/dev_001_SBC/NEMO/OPA_SRC/restart.F90

    r881 r886  
    192192      !!                    has been stored in the restart file. 
    193193      !!---------------------------------------------------------------------- 
    194       REAL(wp) ::   zcoef, zkt, zrdt, zrdttra1, zndastp 
    195 #if defined key_lim2 
    196       INTEGER  ::   ji, jj 
    197 #endif 
     194      REAL(wp) ::   zkt, zrdt, zrdttra1, zndastp 
    198195      !!---------------------------------------------------------------------- 
    199196 
Note: See TracChangeset for help on using the changeset viewer.