Ignore:
Timestamp:
2017-09-05T19:53:41+02:00 (3 years ago)
Author:
clem
Message:

changes in style - part2 -

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90

    r8486 r8498  
    6565      IF( kt == nit000 .AND. lwp ) THEN 
    6666         WRITE(numout,*) 
    67          WRITE(numout,*)'ice_forcing_tau' 
     67         WRITE(numout,*)'ice_forcing_tau : Surface boundary condition for sea ice (momentum)' 
    6868         WRITE(numout,*)'~~~~~~~~~~~~~~~' 
    6969      ENDIF 
     
    124124      IF( kt == nit000 .AND. lwp ) THEN 
    125125         WRITE(numout,*) 
    126          WRITE(numout,*)'ice_forcing_flx' 
     126         WRITE(numout,*)'ice_forcing_flx : Surface boundary condition for sea ice (flux)' 
    127127         WRITE(numout,*)'~~~~~~~~~~~~~~~' 
    128128      ENDIF 
     
    132132 
    133133      ! albedo depends on cloud fraction because of non-linear spectral effects 
    134       DO jl = 1, jpl 
    135          DO jj = 2, jpjm1 
    136             DO ji = 2, jpim1 
    137134!!gm cldf_ice is a real, DOCTOR naming rule: start with cd means CHARACTER passed in argument ! 
    138                alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 
    139             END DO 
    140          END DO 
    141       END DO 
    142       CALL lbc_lnk( alb_ice, 'T', 1. ) 
     135      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    143136       
    144137      SELECT CASE( ksbc )      !==  fluxes over sea ice  ==! 
     
    198191      INTEGER  ::   jl      ! dummy loop index 
    199192      ! 
    200       REAL(wp), DIMENSION(jpi,jpj) :: zalb_m    ! Mean albedo over all categories 
    201       REAL(wp), DIMENSION(jpi,jpj) :: ztem_m    ! Mean temperature over all categories 
    202       ! 
    203       REAL(wp), DIMENSION(jpi,jpj) :: z_qsr_m   ! Mean solar heat flux over all categories 
    204       REAL(wp), DIMENSION(jpi,jpj) :: z_qns_m   ! Mean non solar heat flux over all categories 
    205       REAL(wp), DIMENSION(jpi,jpj) :: z_evap_m  ! Mean sublimation over all categories 
    206       REAL(wp), DIMENSION(jpi,jpj) :: z_dqn_m   ! Mean d(qns)/dT over all categories 
    207       REAL(wp), DIMENSION(jpi,jpj) :: z_devap_m ! Mean d(evap)/dT over all categories 
     193      REAL(wp), DIMENSION(jpi,jpj) ::   z1_at_i   ! inverse of concentration 
     194      ! 
     195      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_qsr_m   ! Mean solar heat flux over all categories 
     196      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_qns_m   ! Mean non solar heat flux over all categories 
     197      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_evap_m  ! Mean sublimation over all categories 
     198      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_dqn_m   ! Mean d(qns)/dT over all categories 
     199      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_devap_m ! Mean d(evap)/dT over all categories 
     200      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zalb_m    ! Mean albedo over all categories 
     201      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztem_m    ! Mean temperature over all categories 
    208202      !!---------------------------------------------------------------------- 
    209203      ! 
    210204      IF( nn_timing == 1 )  CALL timing_start('ice_flx_dist') 
    211205      ! 
     206      WHERE ( at_i (:,:) > 0._wp )   ; z1_at_i(:,:) = 1._wp / at_i (:,:) 
     207      ELSEWHERE                      ; z1_at_i(:,:) = 0._wp 
     208      END WHERE 
     209       
    212210      SELECT CASE( k_limflx )       !==  averaged on all ice categories  ==! 
    213211      ! 
    214212      CASE( 0 , 1 ) 
    215          z_qns_m  (:,:) = fice_ice_ave( pqns_ice  (:,:,:) ) 
    216          z_qsr_m  (:,:) = fice_ice_ave( pqsr_ice  (:,:,:) ) 
    217          z_dqn_m  (:,:) = fice_ice_ave( pdqn_ice  (:,:,:) ) 
    218          z_evap_m (:,:) = fice_ice_ave( pevap_ice (:,:,:) ) 
    219          z_devap_m(:,:) = fice_ice_ave( pdevap_ice(:,:,:) ) 
    220 !!gm faster coding 
    221 !    REAL(wp), DIMENSION(jpi,jpj) ::   z1_at_i   !  
    222 ! ... 
    223 !      WHERE ( at_i (:,:) > 0._wp )   ; z1_at_i(:,:) = 1._wp / at_i (:,:) 
    224 !      ELSEWHERE                      ; z1_at_i(:,:) = 0._wp 
    225 !      END WHERE 
    226 !      z_qns_m  (:,:) = SUM( a_i(:,:,:) * pqns_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:) 
    227 !      z_qsr_m  (:,:) = SUM( a_i(:,:,:) * pqsr_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:) 
    228 !      z_dqn_m  (:,:) = SUM( a_i(:,:,:) * pdqn_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:) 
    229 !      z_evap_m (:,:) = SUM( a_i(:,:,:) * pevap_ice (:,:,:) , dim=3 ) * z1_at_i(:,:) 
    230 !      z_devap_m(:,:) = SUM( a_i(:,:,:) * pdevap_ice(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    231 !! and remove the 2 functions: fice_ice_ave and fice_cell_ave 
    232 !!gm 
     213         ! 
     214         ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) )   
     215         ! 
     216         z_qns_m  (:,:) = SUM( a_i(:,:,:) * pqns_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:) 
     217         z_qsr_m  (:,:) = SUM( a_i(:,:,:) * pqsr_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:) 
     218         z_dqn_m  (:,:) = SUM( a_i(:,:,:) * pdqn_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:) 
     219         z_evap_m (:,:) = SUM( a_i(:,:,:) * pevap_ice (:,:,:) , dim=3 ) * z1_at_i(:,:) 
     220         z_devap_m(:,:) = SUM( a_i(:,:,:) * pdevap_ice(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    233221         DO jl = 1, jpl 
    234             pdqn_ice  (:,:,jl) = z_dqn_m  (:,:) 
    235             pdevap_ice(:,:,jl) = z_devap_m(:,:) 
    236222            pqns_ice  (:,:,jl) = z_qns_m (:,:) 
    237223            pqsr_ice  (:,:,jl) = z_qsr_m (:,:) 
     224            pdqn_ice  (:,:,jl) = z_dqn_m  (:,:) 
    238225            pevap_ice (:,:,jl) = z_evap_m(:,:) 
     226            pdevap_ice(:,:,jl) = z_devap_m(:,:) 
    239227         END DO 
    240228         ! 
     229         DEALLOCATE( z_qns_m, z_qsr_m, z_dqn_m, z_evap_m, z_devap_m )   
     230         ! 
    241231      END SELECT 
    242232      ! 
    243233      SELECT CASE( k_limflx )       !==  redistribution on all ice categories  ==! 
     234      ! 
    244235      CASE( 1 , 2 ) 
    245236         ! 
    246          zalb_m(:,:) = fice_ice_ave( palb_ice(:,:,:) ) 
    247          ztem_m(:,:) = fice_ice_ave( ptn_ice (:,:,:) ) 
     237         ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) )   
     238         ! 
     239         zalb_m(:,:) = SUM( a_i(:,:,:) * palb_ice(:,:,:) , dim=3 ) * z1_at_i(:,:) 
     240         ztem_m(:,:) = SUM( a_i(:,:,:) * ptn_ice (:,:,:) , dim=3 ) * z1_at_i(:,:) 
    248241         DO jl = 1, jpl 
    249242            pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
     
    252245         END DO 
    253246         ! 
     247         DEALLOCATE( zalb_m, ztem_m )   
     248         ! 
    254249      END SELECT 
    255250      ! 
     
    257252      ! 
    258253   END SUBROUTINE ice_flx_dist 
    259  
    260 !!gm TO BE REMOVED ====>>>>> 
    261    FUNCTION fice_cell_ave ( ptab ) 
    262       !!-------------------------------------------------------------------------- 
    263       !! * Compute average over categories, for grid cell (ice covered and free ocean) 
    264       !!-------------------------------------------------------------------------- 
    265       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(in) :: ptab 
    266       REAL(wp), DIMENSION(jpi,jpj)                 :: fice_cell_ave 
    267       INTEGER :: jl 
    268       !!-------------------------------------------------------------------------- 
    269       fice_cell_ave(:,:) = a_i(:,:,1) * ptab (:,:,1) 
    270       DO jl = 2, jpl 
    271          fice_cell_ave(:,:) = fice_cell_ave(:,:) + a_i(:,:,jl) * ptab (:,:,jl) 
    272       END DO 
    273    END FUNCTION fice_cell_ave 
    274  
    275  
    276    FUNCTION fice_ice_ave ( ptab ) 
    277       !!-------------------------------------------------------------------------- 
    278       !! * Compute average over categories, for ice covered part of grid cell 
    279       !!-------------------------------------------------------------------------- 
    280       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(in) ::   ptab   ! 
    281       REAL(wp), DIMENSION(jpi,jpj)                 :: fice_ice_ave 
    282       !!-------------------------------------------------------------------------- 
    283       WHERE ( at_i (:,:) > 0.0_wp ) ; fice_ice_ave (:,:) = fice_cell_ave( ptab (:,:,:) ) / at_i (:,:) 
    284       ELSEWHERE                     ; fice_ice_ave (:,:) = 0.0_wp 
    285       END WHERE 
    286    END FUNCTION fice_ice_ave 
    287  
    288 !!gm <<<<<<====  end of TO BE REMOVED  
    289254 
    290255#else 
Note: See TracChangeset for help on using the changeset viewer.