Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r2528 r2715 18 18 USE phycst ! physical constants 19 19 USE in_out_manager ! I/O manager 20 USE lib_mpp ! MPP library 20 21 21 22 IMPLICIT NONE … … 47 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 48 49 !! $Id$ 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 51 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 !!---------------------------------------------------------------------- 52 52 CONTAINS 53 53 … … 65 65 !! References : Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 66 66 !!---------------------------------------------------------------------- 67 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 68 USE wrk_nemo, ONLY: wrk_3d_6 , wrk_3d_7 ! 3D workspace 69 !! 67 70 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pt_ice ! ice surface temperature (Kelvin) 68 71 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_ice ! sea-ice thickness … … 82 85 REAL(wp) :: zihsc2 ! = 1 hsn >= c2 ; = 0 hsn < c2 83 86 !! 84 LOGICAL , DIMENSION(jpi,jpj,SIZE(pt_ice,3)) :: llmask 85 REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) :: zalbfz ! = rn_alphdi for freezing ice ; = rn_albice for melting ice 86 REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) :: zficeth ! function of ice thickness 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalbfz ! = rn_alphdi for freezing ice ; = rn_albice for melting ice 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zficeth ! function of ice thickness 87 89 !!--------------------------------------------------------------------- 88 90 89 91 ijpl = SIZE( pt_ice, 3 ) ! number of ice categories 92 93 IF( wrk_in_use(3, 6,7) ) THEN 94 CALL ctl_stop('albedo_ice: requested workspace arrays are unavailable') ; RETURN 95 ENDIF 96 ! Associate pointers with sub-arrays of workspace arrays 97 zalbfz => wrk_3d_6(:,:,1:ijpl) 98 zficeth => wrk_3d_7(:,:,1:ijpl) 90 99 91 100 IF( albd_init == 0 ) CALL albedo_init ! initialization … … 94 103 ! Computation of zficeth 95 104 !--------------------------- 96 llmask = ( ph_snw == 0.e0 ) .AND. ( pt_ice >= rt0_ice )97 105 ! ice free of snow and melts 98 WHERE( llmask ) ; zalbfz = rn_albice 99 ELSEWHERE ; zalbfz = rn_alphdi 106 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalbfz(:,:,:) = rn_albice 107 ELSE WHERE ; zalbfz(:,:,:) = rn_alphdi 108 END WHERE 109 110 WHERE ( 1.5 < ph_ice ) ; zficeth = zalbfz 111 ELSE WHERE( 1.0 < ph_ice .AND. ph_ice <= 1.5 ) ; zficeth = 0.472 + 2.0 * ( zalbfz - 0.472 ) * ( ph_ice - 1.0 ) 112 ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 ) ; zficeth = 0.2467 + 0.7049 * ph_ice & 113 & - 0.8608 * ph_ice * ph_ice & 114 & + 0.3812 * ph_ice * ph_ice * ph_ice 115 ELSE WHERE ; zficeth = 0.1 + 3.6 * ph_ice 100 116 END WHERE 101 117 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 117 END DO 118 END DO 118 !!gm old code 119 ! DO jl = 1, ijpl 120 ! DO jj = 1, jpj 121 ! DO ji = 1, jpi 122 ! IF( ph_ice(ji,jj,jl) > 1.5 ) THEN 123 ! zficeth(ji,jj,jl) = zalbfz(ji,jj,jl) 124 ! ELSEIF( ph_ice(ji,jj,jl) > 1.0 .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN 125 ! zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ph_ice(ji,jj,jl) - 1.0 ) 126 ! ELSEIF( ph_ice(ji,jj,jl) > 0.05 .AND. ph_ice(ji,jj,jl) <= 1.0 ) THEN 127 ! zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ph_ice(ji,jj,jl) & 128 ! & - 0.8608 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl) & 129 ! & + 0.3812 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl) * ph_ice (ji,jj,jl) 130 ! ELSE 131 ! zficeth(ji,jj,jl) = 0.1 + 3.6 * ph_ice(ji,jj,jl) 132 ! ENDIF 133 ! END DO 134 ! END DO 135 ! END DO 136 !!gm end old code 119 137 120 138 !----------------------------------------------- … … 155 173 pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud ! Oberhuber correction 156 174 ! 175 IF( wrk_not_released(3, 6,7) ) CALL ctl_stop('albedo_ice: failed to release workspace arrays') 176 ! 157 177 END SUBROUTINE albedo_ice 158 178 … … 163 183 !! 164 184 !! ** Purpose : Computation of the albedo of the ocean 165 !! 166 !! ** Method : .... 167 !!---------------------------------------------------------------------- 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 185 !!---------------------------------------------------------------------- 186 REAL(wp), DIMENSION(:,:), INTENT(out) :: pa_oce_os ! albedo of ocean under overcast sky 187 REAL(wp), DIMENSION(:,:), INTENT(out) :: pa_oce_cs ! albedo of ocean under clear sky 188 !! 189 REAL(wp) :: zcoef ! local scalar 172 190 !!---------------------------------------------------------------------- 173 191 !
Note: See TracChangeset
for help on using the changeset viewer.
