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 for branches/dev_001_SBC/NEMO/OPA_SRC/SBC – NEMO

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/OPA_SRC/SBC
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed
  • 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 
Note: See TracChangeset for help on using the changeset viewer.