Changeset 886 for branches/dev_001_SBC/NEMO/OPA_SRC/SBC
- Timestamp:
- 2008-04-11T11:24:17+02:00 (16 years ago)
- 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 7 7 !! 8.5 ! 03-07 (C. Ethe, G. Madec) Optimization (old name:shine) 8 8 !! 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 !!---------------------------------------------------------------------- 17 16 USE phycst ! physical constants 18 USE in_out_manager 17 USE in_out_manager ! I/O manager 19 18 20 19 IMPLICIT NONE 21 20 PRIVATE 22 21 23 PUBLIC blk_albedo ! routine called by sbcice_lim module24 25 INTEGER :: albd_init = 0 !: control flag for initialization 26 27 REAL(wp) :: zzero = 0.e0 ! constant values28 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 ! " " 29 28 30 29 REAL(wp) :: c1 = 0.05 ! constants values 31 30 REAL(wp) :: c2 = 0.10 ! " " 32 REAL(wp) :: cmue = 0.40 ! cosine of local solar altitude31 REAL(wp) :: rmue = 0.40 ! cosine of local solar altitude 33 32 34 33 !!* namelist namalb … … 36 35 cgren = 0.06 , & ! correction of the snow or ice albedo to take into account 37 36 ! ! 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 38 40 albice = 0.50 , & ! albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 41 #endif 39 42 alphd = 0.80 , & ! coefficients for linear interpolation used to compute 40 43 alphdi = 0.72 , & ! albedo between two extremes values (Pyane, 1972) 41 44 alphc = 0.65 42 NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc43 45 44 46 !!---------------------------------------------------------------------- … … 50 52 CONTAINS 51 53 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 *** 60 57 !! 61 58 !! ** Purpose : Computation of the albedo of the snow/ice system … … 68 65 !! References : Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 69 66 !!---------------------------------------------------------------------- 70 USE ice_2 ! ???71 !!72 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: palb ! albedo of ice under overcast sky73 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: palcn ! albedo of ocean under overcastsky74 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: palbp ! albedo of ice under clear sky75 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palcnp ! albedo of ocean under clear sky76 !!77 INTEGER :: ji, jj ! dummy loop indices78 REAL(wp) :: z coef, & ! temporary scalar79 zalbpsnm , & ! albedo of ice under clear sky when snow is melting80 zalbpsnf , & ! albedo of ice under clear sky when snow is freezing81 zalbpsn , & ! albedo of snow/ice system when ice is coverd bysnow82 zalbpic , & ! albedo of snow/ice system when ice is free of snow83 zithsn , & ! = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free ofsnow)84 zitmlsn , & ! = 1 freezinz snow (sist >=rt0_snow) ; = 0 melting snow (sist<rt0_snow)85 zihsc1 , & ! = 1 hsn <= c1 ; = 0 hsn > c186 zihsc2 ! = 1 hsn >= c2 ; = 0 hsn < c287 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 thickness67 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 90 87 !!--------------------------------------------------------------------- 91 88 89 ijpl = SIZE( pt_ice, 3 ) ! number of ice categories 90 92 91 IF( albd_init == 0 ) CALL albedo_init ! initialization 93 92 … … 95 94 ! Computation of zficeth 96 95 !--------------------------- 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 103 100 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 118 117 END DO 119 118 END DO … … 125 124 ! Albedo of snow-ice for clear sky. 126 125 !----------------------------------------------- 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 130 142 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) 139 145 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 149 150 END DO 150 151 END DO … … 152 153 ! Albedo of snow-ice for overcast sky. 153 154 !---------------------------------------------- 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 *** 174 163 !! 175 164 !! ** Purpose : Computation of the albedo of the ocean … … 177 166 !! ** Method : .... 178 167 !!---------------------------------------------------------------------- 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 198 180 199 181 SUBROUTINE albedo_init … … 205 187 !! ** Method : Read the namelist namalb 206 188 !!---------------------------------------------------------------------- 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 ) 211 197 READ ( numnam, namalb ) 212 198 -
branches/dev_001_SBC/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r881 r886 308 308 309 309 #if defined key_cpl_albedo 310 # if defined key_lim3 311 Must be adapted for LIM3 312 # endif 310 313 tn_ice = 271.285 311 314 alb_ice = 0.75 -
branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbc_ice.F90
r881 r886 6 6 !! History : 9.0 ! 06-08 (G. Modec) Surface module 7 7 !!---------------------------------------------------------------------- 8 #if defined key_lim 28 #if defined key_lim3 || defined key_lim2 9 9 !!---------------------------------------------------------------------- 10 !! 'key_lim2' : LIM 2.0 sea-ice model10 !! 'key_lim2' or 'key_lim3' : LIM 2.0 or 3.0 sea-ice model 11 11 !!---------------------------------------------------------------------- 12 12 USE par_oce ! ocean parameters 13 #if defined key_lim3 14 USE par_ice ! ice parameters 15 #endif 13 16 14 17 IMPLICIT NONE 15 18 PRIVATE 16 19 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 19 26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qns_ice !: non solar heat flux over ice [W/m2] 20 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qsr_ice !: solar heat flux over ice [W/m2] 21 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: dqns_ice !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 22 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tn_ice !: ice surface temperature [K] 30 #endif 31 23 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tprecip !: total precipitation [Kg/m2/s] 24 33 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] 25 36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fr1_i0 !: 1st fraction of sol. rad. which penetrate inside the ice cover 26 37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fr2_i0 !: 2nd fraction of sol. rad. which penetrate inside the ice cover 27 38 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: &29 39 #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 32 49 #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 36 59 #endif 37 60 -
branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcana.F90
r756 r886 119 119 INTEGER, INTENT(in) :: kt ! ocean time step 120 120 121 INTEGER :: ji, jj , js! dummy loop indices121 INTEGER :: ji, jj ! dummy loop indices 122 122 INTEGER :: zyear0 ! initial year 123 123 INTEGER :: zmonth0 ! initial month 124 124 INTEGER :: zday0 ! initial day 125 125 INTEGER :: zday_year0 ! initial day since january 1st 126 INTEGER :: zdaymax !127 126 REAL(wp) :: ztau , ztau_sais ! wind intensity and of the seasonal cycle 128 127 REAL(wp) :: ztime ! time in hour … … 283 282 WRITE(numout,*)' adatrj = ',adatrj 284 283 WRITE(numout,*)' ztime = ',ztime 285 WRITE(numout,*)' zdaymax = ',zdaymax286 284 287 285 WRITE(numout,*)' ztimemax = ',ztimemax -
branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r881 r886 30 30 USE albedo 31 31 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 33 36 USE par_ice_2 34 37 USE ice_2 … … 41 44 42 45 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-point44 INTEGER , PARAMETER :: jp_ wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at V-point46 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 45 48 INTEGER , PARAMETER :: jp_wndm = 3 ! index of 10m wind module (m/s) at T-point 46 49 INTEGER , PARAMETER :: jp_humi = 4 ! index of specific humidity ( % ) … … 49 52 INTEGER , PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s) 50 53 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 51 52 53 !!54 !!!!gm to be moved55 INTEGER, PARAMETER :: jpl = 1 ! number of layer in the ice56 !!!!gm to be moved57 58 54 59 55 INTEGER, PARAMETER :: jpintsr = 24 ! number of time step between sunrise and sunset … … 127 123 CHARACTER(len=100) :: cn_dir ! Root directory for location of CLIO files 128 124 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 read125 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_wndm, sn_tair ! informations about the fields to be read 130 126 TYPE(FLD_N) :: sn_humi, sn_ccov, sn_prec ! " " 131 127 !! 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, & 133 129 & sn_ccov, sn_tair, sn_prec 134 130 !!--------------------------------------------------------------------- … … 143 139 ! ! file ! frequency ! variable ! time intep ! clim ! starting ! 144 140 ! ! 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 ) 147 143 sn_wndm = FLD_N( 'mwnd10m' , 24. , 'm_10' , .true. , 0 , 0 ) 148 144 sn_tair = FLD_N( 'tair10m' , 24. , 't_10' , .FALSE. , 0 , 0 ) … … 155 151 156 152 ! store namelist information in an array 157 slf_i(jp_ wndi) = sn_wndi ; slf_i(jp_wndj) = sn_wndj; slf_i(jp_wndm) = sn_wndm153 slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau ; slf_i(jp_wndm) = sn_wndm 158 154 slf_i(jp_tair) = sn_tair ; slf_i(jp_humi) = sn_humi 159 155 slf_i(jp_ccov) = sn_ccov ; slf_i(jp_prec) = sn_prec … … 203 199 WRITE(numout,*) 204 200 ifpr = INT(jpi/8) ; jfpr = INT(jpj/10) 205 WRITE(numout,*) TRIM(sf(jp_ wndi)%clvar),' day: ',ndastp206 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 ) 207 203 WRITE(numout,*) 208 WRITE(numout,*) TRIM(sf(jp_ wndj)%clvar),' day: ',ndastp209 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 ) 210 206 WRITE(numout,*) 211 207 WRITE(numout,*) TRIM(sf(jp_humi)%clvar),' day: ',ndastp … … 246 242 !! follow the work of Oberhuber, 1988 247 243 !! - 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) 249 245 !! - compute shortwave radiation for ocean (call blk_clio_qsr_oce) 250 246 !! - compute long-wave radiation for the ocean … … 269 265 REAL(wp) :: zdtetar, ztvmoyr, zlxins, zchcm, zclcm ! - - 270 266 REAL(wp) :: zmt1, zmt2, zmt3, ztatm3, ztamr, ztaevbk ! - - 271 REAL(wp) :: zsst, ztatm, zcco1, zpatm 267 REAL(wp) :: zsst, ztatm, zcco1, zpatm, zinda ! - - 272 268 REAL(wp) :: zrhoa, zev, zes, zeso, zqatm, zevsqr ! - - 273 269 !! … … 285 281 DO jj = 1 , jpj 286 282 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) 289 285 END DO 290 286 END DO … … 295 291 296 292 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 297 301 298 302 … … 423 427 !! follow the work of Oberhuber, 1988 424 428 !! 425 !! ** Action : call flx_blk_albedo to compute ocean andice albedo429 !! ** Action : call albedo_oce/albedo_ice to compute ocean/ice albedo 426 430 !! computation of snow precipitation 427 431 !! computation of solar flux at the ocean and ice surfaces … … 433 437 !! 434 438 !!---------------------------------------------------------------------- 435 REAL(wp), INTENT(in ), DIMENSION( jpi,jpj,jpl):: pst ! ice surface temperature [Kelvin]436 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) 437 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) 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) 441 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) 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 ) 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) 452 456 !! 453 457 INTEGER :: ji, jj, jl ! dummy loop indices 458 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 454 459 !! 455 460 REAL(wp) :: zcoef, zmt1, zmt2, zmt3, ztatm3 ! temporary scalars … … 464 469 REAL(wp), DIMENSION(jpi,jpj) :: zevsqr ! vapour pressure square-root 465 470 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa ! air density 466 REAL(wp), DIMENSION(jpi,jpj, jpl) :: z_qlw, z_qsb471 REAL(wp), DIMENSION(jpi,jpj,SIZE(pst,3)) :: z_qlw, z_qsb 467 472 !!--------------------------------------------------------------------- 468 473 474 ijpl = SIZE( pst, 3 ) ! number of ice categories 469 475 zpatm = 101000. ! atmospheric pressure (assumed constant here) 470 476 … … 548 554 549 555 ! ! ========================== ! 550 DO jl = 1, jpl! Loop over ice categories !556 DO jl = 1, ijpl ! Loop over ice categories ! 551 557 ! ! ========================== ! 552 558 !CDIR NOVERRCHK … … 602 608 p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity 603 609 END DO 604 END DO 605 END DO 606 610 ! 611 END DO 612 ! 613 END DO 607 614 ! 608 615 ! ----------------------------------------------------------------------------- ! 609 ! IIITotal FLUXES !616 ! Total FLUXES ! 610 617 ! ----------------------------------------------------------------------------- ! 611 618 ! 612 619 !CDIR COLLAPSE 613 p_qns(:,:,:) = 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] 616 623 ! 617 624 !!gm : not necessary as all input data are lbc_lnk... 618 625 CALL lbc_lnk( p_fr1 (:,:) , 'T', 1. ) 619 626 CALL lbc_lnk( p_fr2 (:,:) , 'T', 1. ) 620 DO jl = 1, jpl627 DO jl = 1, ijpl 621 628 CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. ) 622 629 CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. ) … … 626 633 627 634 !!gm : mask is not required on forcing 628 DO jl = 1, jpl635 DO jl = 1, ijpl 629 636 p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 630 637 p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) … … 634 641 635 642 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 : ') 641 649 ENDIF 642 650 … … 667 675 REAL(wp) :: zmt1, zmt2, zmt3 ! 668 676 REAL(wp) :: zdecl, zsdecl , zcdecl ! 669 REAL(wp) :: za_oce, ztamr , zinda!670 671 REAL(wp) :: zdl, zlha ! local scalars672 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 ! 674 682 REAL(wp) :: zes 675 683 !! 676 REAL(wp), DIMENSION(jpi,jpj) :: zev ! vapour pressure684 REAL(wp), DIMENSION(jpi,jpj) :: zev ! vapour pressure 677 685 REAL(wp), DIMENSION(jpi,jpj) :: zdlha, zlsrise, zlsset ! 2D workspace 678 686 … … 786 794 END DO 787 795 ! 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....789 796 zcoef1 = srgamma * zdaycor / ( 2. * rpi ) 790 797 !CDIR COLLAPSE … … 794 801 zcldcor = MIN( 1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj) & ! cloud correction (Reed 1977) 795 802 & + 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 798 804 END DO 799 805 END DO … … 812 818 !! - also initialise sbudyko and stauc once for all 813 819 !!---------------------------------------------------------------------- 814 REAL(wp), INTENT(in ), DIMENSION( jpi,jpj,jpl) :: pa_ice_cs ! albedo of ice under clear sky815 REAL(wp), INTENT(in ), DIMENSION( jpi,jpj,jpl) :: pa_ice_os ! albedo of ice under overcast sky816 REAL(wp), INTENT( out), DIMENSION( jpi,jpj,jpl) :: pqsr_ice ! shortwave radiation over the ice/snow820 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 817 823 !! 818 824 INTEGER, PARAMETER :: jp24 = 24 ! sampling of the daylight period (sunrise to sunset) into 24 equal parts 819 825 !! 820 826 INTEGER :: ji, jj, jl, jt ! dummy loop indices 827 INTEGER :: ijpl ! number of ice categories (3rd dim of pqsr_ice) 821 828 INTEGER :: indaet ! = -1, 0, 1 for odd, normal and leap years resp. 822 829 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 838 840 REAL(wp), DIMENSION(jpi,jpj) :: zps, zpc ! sine (cosine) of latitude per sine (cosine) of solar declination 839 841 !!--------------------------------------------------------------------- 842 843 ijpl = SIZE(pqsr_ice, 3 ) ! number of ice categories 840 844 841 845 ! Saturated water vapour and vapour pressure … … 895 899 ! compute and sum ice qsr over the daylight for each ice categories 896 900 pqsr_ice(:,:,:) = 0.e0 897 zcoef1 = zdaycor / ( 2. * rpi ) 901 zcoef1 = zdaycor / ( 2. * rpi ) ! Correction for the ellipsity of the earth orbit 898 902 899 903 ! !----------------------------! 900 DO jl = 1, jpl! loop over ice categories !904 DO jl = 1, ijpl ! loop over ice categories ! 901 905 ! !----------------------------! 902 906 !CDIR NOVERRCHK … … 930 934 ! !--------------------------------! 931 935 END DO ! end loop over ice categories ! 932 !!--------------------------------!936 ! !--------------------------------! 933 937 934 938 935 939 !!gm : this should be suppress as input data have been passed through lbc_lnk 936 DO jl = 1, jpl940 DO jl = 1, ijpl 937 941 CALL lbc_lnk( pqsr_ice(:,:,jl) , 'T', 1. ) 938 942 END DO -
branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r879 r886 4 4 !! Ocean forcing: momentum, heat and freshwater flux formulation 5 5 !!===================================================================== 6 !! History : 9.0 ! 04-08 (U. Schweckendiek) Original code7 !! 6 !! History : 1.0 ! 04-08 (U. Schweckendiek) Original code 7 !! 2.0 ! 05-04 (L. Brodeau, A.M. Treguier) additions: 8 8 !! - new bulk routine for efficiency 9 9 !! - WINDS ARE NOW ASSUMED TO BE AT T POINTS in input files !!!! 10 10 !! - file names and file characteristics in namelist 11 11 !! - Implement reading of 6-hourly fields 12 !! 12 !! 3.0 ! 06-06 (G. Madec) sbc rewritting 13 13 !!---------------------------------------------------------------------- 14 14 … … 66 66 !!---------------------------------------------------------------------- 67 67 !! OPA 9.0 , LOCEAN-IPSL (2006) 68 !! $ Header: $68 !! $ Id: $ 69 69 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 70 70 !!---------------------------------------------------------------------- … … 184 184 ENDIF 185 185 186 CALL fld_read( kt, nn_fsbc, sf ) ! Read input fields and provides the 187 ! ! input fieldsat the current time-step186 187 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 188 188 189 189 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 193 191 ENDIF 194 192 ! ! using CORE bulk formulea … … 208 206 !! ** Outputs : - utau : i-component of the stress at U-point (N/m2) 209 207 !! - 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) 212 210 !! - evap : Evaporation over the ocean (kg/m2/s) 213 211 !! - tprecip : Total precipitation (Kg/m2/s) … … 334 332 & tab2d_2=vtau , clinfo2=' vtau : ', mask2=vmask ) 335 333 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 : ') 336 335 ENDIF 337 336 … … 354 353 & p_qla , p_dqns, p_dqla, & 355 354 & p_tpr , p_spr , & 356 & p_fr1 , p_fr2 )355 & p_fr1 , p_fr2 , cd_grid ) 357 356 !!--------------------------------------------------------------------- 358 357 !! *** ROUTINE blk_ice_core *** … … 367 366 !! caution : the net upward water flux has with mm/day unit 368 367 !!--------------------------------------------------------------------- 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 396 397 !!--------------------------------------------------------------------- 398 399 ijpl = SIZE( pst, 3 ) ! number of ice categories 397 400 398 401 ! local scalars ( place there for vector optimisation purposes) 399 402 zcoef_wnorm = rhoa * Cice 403 zcoef_wnorm2 = rhoa * Cice * 0.5 400 404 zcoef_dqlw = 4.0 * 0.95 * Stef 401 405 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8) … … 410 414 411 415 ! ----------------------------------------------------------------------------- ! 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) 416 421 #if defined key_vectopt_loop 417 422 !CDIR COLLAPSE 418 423 #endif 419 424 !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 437 443 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 ! 438 523 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 ! 488 525 !-------------------------------------------------------------------- 489 526 ! FRACTIONs of net shortwave radiation which is not absorbed in the … … 502 539 ! 503 540 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 : ') 510 549 ENDIF 511 550 … … 801 840 END FUNCTION psi_h 802 841 803 804 842 !!====================================================================== 805 843 END MODULE sbcblk_core -
branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r882 r886 52 52 PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90 53 53 54 CHARACTER(len=1) :: cl_grid = 'B' ! type of grid used in ice dynamics 55 54 56 !! * Substitutions 55 57 # include "domzgr_substitute.h90" … … 87 89 !! 88 90 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 93 101 !!---------------------------------------------------------------------- 94 102 … … 104 112 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 105 113 ! 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) 107 116 DO jj = 2, jpj 108 117 DO ji = fs_2, jpi ! vector opt. … … 117 126 tfu(:,:) = tfreez( sss_m ) + rt0 118 127 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 ) 121 133 122 134 ! ... Sea-ice surface boundary conditions output from bulk formulae : … … 135 147 SELECT CASE( kblk ) 136 148 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 ) 142 154 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) 148 160 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) 149 165 150 166 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/dev_001_SBC/NEMO/OPA_SRC/SBC/sbcmod.F90
r881 r886 26 26 USE sbcblk_core ! surface boundary condition: bulk formulation : CORE 27 27 USE sbcice_if ! surface boundary condition: ice-if sea-ice model 28 USE sbcice_lim ! surface boundary condition: LIM 3.0 sea-ice model 28 29 USE sbcice_lim_2 ! surface boundary condition: LIM 2.0 sea-ice model 29 30 USE sbccpl ! surface boundary condition: coupled florulation … … 96 97 !!gmhere no overwrite, test all option via namelist change: require more incore memory 97 98 !!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 99 101 IF( cp_cfg == 'gyre' ) THEN 100 102 ln_ana = .TRUE. … … 229 231 ! ! (update heat and freshwater fluxes) 230 232 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 231 235 END SELECT ! (update all fluxes using bulk + LIM) 232 236
Note: See TracChangeset
for help on using the changeset viewer.