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 6723 for branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2016-06-19T11:36:47+02:00 (8 years ago)
Author:
gm
Message:

#1751 - branch SIMPLIF_6_aerobulk: add aerobulk package including NCAR, COARE and ECMWF bulk

Location:
branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC
Files:
5 added
3 deleted
11 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90

    r6493 r6723  
    1010 
    1111   !!---------------------------------------------------------------------- 
    12    !!   diurnal_sst_coolskin_step  : time-step the cool skin corrections 
     12   !!   diurnal_sst_coolskin_init : initialisation of the cool skin 
     13   !!   diurnal_sst_coolskin_step : time-stepping  of the cool skin corrections 
    1314   !!---------------------------------------------------------------------- 
    1415   USE par_kind 
    … …  
    2122    
    2223   IMPLICIT NONE 
    23     
     24   PRIVATE 
     25 
    2426   ! Namelist parameters 
    2527 
    … …  
    3739   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csthick   ! Cool skin thickness 
    3840 
    39    PRIVATE 
    4041   PUBLIC diurnal_sst_coolskin_step, diurnal_sst_coolskin_init 
    4142 
    4243      !! * Substitutions 
    4344#  include "vectopt_loop_substitute.h90" 
    44     
     45   !!---------------------------------------------------------------------- 
     46   !! NEMO/OPA 4.0 , NEMO-consortium (2016)  
     47   !! $Id:  $ 
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     49   !!----------------------------------------------------------------------    
    4550   CONTAINS  
    4651    
    … …  
    5661      !!  
    5762      !!---------------------------------------------------------------------- 
    58        
    59       IMPLICIT NONE 
    60        
    6163      ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) ) 
    6264      x_csdsst = 0. 
    6365      x_csthick = 0. 
    64        
     66      ! 
    6567   END SUBROUTINE diurnal_sst_coolskin_init 
    66   
     68 
     69 
    6770   SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt) 
    6871      !!---------------------------------------------------------------------- 
    … …  
    7578      !! ** Reference :  
    7679      !!---------------------------------------------------------------------- 
    77       
    78       IMPLICIT NONE 
    79       
    8080      ! Dummy variables 
    8181      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux     ! Heat (non-solar)(Watts) 
    … …  
    9494      
    9595      INTEGER :: ji,jj 
    96       
    97       IF ( .NOT. ln_blk_core ) THEN 
    98          CALL ctl_stop("cool_skin.f90: diurnal flux processing only implemented"//& 
    99          &             " for core bulk forcing") 
    100       ENDIF 
    101   
     96      !!---------------------------------------------------------------------- 
     97      ! 
     98      IF( .NOT. ln_blk )   CALL ctl_stop("cool_skin.f90: diurnal flux processing only implemented for bulk forcing") 
     99      ! 
    102100      DO jj = 1,jpj 
    103101         DO ji = 1,jpi 
    104              
     102            ! 
    105103            ! Calcualte wind speed from wind stress and friction velocity 
    106104            IF( tmask(ji,jj,1) == 1. .AND. pstauflux(ji,jj) /= 0 .AND. psrho(ji,jj) /=0 ) THEN 
    … …  
    111109               z_wspd(ji,jj) = 0.      
    112110            ENDIF 
    113  
    114   
     111            ! 
    115112            ! Calculate gamma function which is dependent upon wind speed 
    116113            IF( tmask(ji,jj,1) == 1. ) THEN 
    … …  
    119116               IF( ( z_wspd(ji,jj) >= 10. ) ) z_gamma(ji,jj) = 6. 
    120117            ENDIF 
    121  
    122  
     118            ! 
    123119            ! Calculate lamda function 
    124120            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN 
    … …  
    127123               z_lamda(ji,jj) = 0. 
    128124            ENDIF 
    129  
    130  
    131  
     125            ! 
    132126            ! Calculate the cool skin thickness - only when heat flux is out of the ocean 
    133127            IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 .AND. psqflux(ji,jj) < 0 ) THEN 
    134                 x_csthick(ji,jj) = ( z_lamda(ji,jj) * pp_v ) / z_fv(ji,jj) 
     128               x_csthick(ji,jj) = ( z_lamda(ji,jj) * pp_v ) / z_fv(ji,jj) 
    135129            ELSE 
    136                 x_csthick(ji,jj) = 0. 
     130               x_csthick(ji,jj) = 0. 
    137131            ENDIF 
    138  
    139  
    140  
     132            ! 
    141133            ! Calculate the cool skin correction - only when the heat flux is out of the ocean 
    142134            IF( tmask(ji,jj,1) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN 
    … …  
    145137               x_csdsst(ji,jj) = 0. 
    146138            ENDIF 
    147  
    148          ENDDO 
    149       ENDDO 
    150  
     139            ! 
     140         END DO 
     141      END DO 
     142      ! 
    151143   END SUBROUTINE diurnal_sst_coolskin_step 
    152144 
    153  
     145   !!====================================================================== 
    154146END MODULE cool_skin 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/DIU/step_diu.F90

    r6017 r6723  
    6464      
    6565      ! Cool skin 
    66       IF ( .NOT.ln_diurnal ) CALL ctl_stop(  "stp_diurnal: ln_diurnal not set" ) 
     66      IF( .NOT.ln_diurnal )   CALL ctl_stop( "stp_diurnal: ln_diurnal not set" ) 
    6767          
    68       IF ( .NOT. ln_blk_core ) THEN 
    69          CALL ctl_stop("step.f90: diurnal flux processing only implemented"//& 
    70          &             " for core forcing")  
    71       ENDIF 
     68      IF( .NOT. ln_blk    )   CALL ctl_stop( "stp_diurnal: diurnal flux processing only implemented for bulk forcing" )  
    7269 
    7370      CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rdt) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90

    r5215 r6723  
    2727   PRIVATE 
    2828 
    29    PUBLIC   wnd_cyc   ! routine called in sbcblk_core.F90 module 
     29   PUBLIC   wnd_cyc   ! routine called in sbcblk.F90 module 
    3030 
    3131   INTEGER , PARAMETER ::   jp_is1  = 1   ! index of presence 1 or absence 0 of a TC record 
    … …  
    102102         sn_tc = FLD_N( 'tc_track',     6     ,  'tc'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         , ''            ) 
    103103         ! 
    104          !  Namelist is read in namsbc_core 
     104         !  Namelist is read in namsbc_blk 
    105105         ! set sf structure 
    106106         ALLOCATE( sf(1), STAT=ierror ) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r6140 r6723  
    924924         WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) 
    925925         WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) 
    926          WRITE(numout,*) '          '//TRIM( cdnam )//' Namelist' 
    927          WRITE(numout,*) '          list of files and frequency (>0: in hours ; <0 in months)' 
     926         WRITE(numout,*) '   Namelist '//TRIM( cdnam ) 
     927         WRITE(numout,*) '      list of files and frequency (>0: in hours ; <0 in months)' 
    928928         DO jf = 1, SIZE(sdf) 
    929             WRITE(numout,*) '               root filename: '  , TRIM( sdf(jf)%clrootname ),   & 
    930                &                          ' variable name: '  , TRIM( sdf(jf)%clvar      ) 
    931             WRITE(numout,*) '               frequency: '      ,       sdf(jf)%nfreqh      ,   & 
    932                &                          ' time interp: '    ,       sdf(jf)%ln_tint     ,   & 
    933                &                          ' climatology: '    ,       sdf(jf)%ln_clim     ,   & 
    934                &                          ' weights    : '    , TRIM( sdf(jf)%wgtname    ),   & 
    935                &                          ' pairing    : '    , TRIM( sdf(jf)%vcomp      ),   & 
    936                &                          ' data type: '      ,       sdf(jf)%cltype      ,   & 
    937                &                          ' land/sea mask:'   , TRIM( sdf(jf)%lsmname    ) 
     929            WRITE(numout,*) '      root filename: '  , TRIM( sdf(jf)%clrootname ), '   variable name: ', TRIM( sdf(jf)%clvar) 
     930            WRITE(numout,*) '         frequency: '      ,       sdf(jf)%nfreqh      ,   & 
     931               &                  '   time interp: '    ,       sdf(jf)%ln_tint     ,   & 
     932               &                  '   climatology: '    ,       sdf(jf)%ln_clim 
     933            WRITE(numout,*) '         weights: '        , TRIM( sdf(jf)%wgtname    ),   & 
     934               &                  '   pairing: '        , TRIM( sdf(jf)%vcomp      ),   & 
     935               &                  '   data type: '      ,       sdf(jf)%cltype      ,   & 
     936               &                  '   land/sea mask:'   , TRIM( sdf(jf)%lsmname    ) 
    938937            call flush(numout) 
    939938         END DO 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r6140 r6723  
    1010   !!            3.3  ! 2010-10  (J. Chanut, C. Bricaud)  add the surface pressure forcing 
    1111   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model  
     12   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk) 
    1213   !!---------------------------------------------------------------------- 
    1314 
    … …  
    3233   LOGICAL , PUBLIC ::   ln_ana         !: analytical boundary condition flag 
    3334   LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation 
    34    LOGICAL , PUBLIC ::   ln_blk_clio    !: CLIO bulk formulation 
    35    LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk formulation 
    36    LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
     35   LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation 
    3736#if defined key_oasis3 
    3837   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
    … …  
    7574   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical                    formulation 
    7675   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation 
    77    INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk                     formulation 
    78    INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk                     formulation 
     76   INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 4        !: bulk                          formulation 
    7977   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation 
    80    INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk                     formulation 
    8178   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 7        !: for OPA when doing coupling via SAS module 
    8279    

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r6140 r6723  
    2424   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2525   USE sbc_ice         ! Surface boundary condition: ice   fields 
    26    USE sbcblk_core     ! Surface boundary condition: CORE bulk 
     26   USE sbcblk          ! Surface boundary condition: bulk 
    2727   USE sbccpl 
    2828 
    … …  
    191191            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
    192192         ENDIF 
    193       ELSEIF (ksbc == jp_core) THEN 
     193      ELSEIF (ksbc == jp_blk) THEN 
    194194         IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 
    195195            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 
    … …  
    392392         ENDDO 
    393393 
    394       ELSE IF (ksbc == jp_core) THEN 
    395  
    396 ! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) 
     394      ELSE IF (ksbc == jp_blk) THEN 
     395 
     396! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself) 
    397397! x comp and y comp of atmosphere surface wind (CICE expects on T points) 
    398398         ztmp(:,:) = wndi_ice(:,:) 
    … …  
    585585! Better to use evap and tprecip? (but for now don't read in evap in this case) 
    586586         emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
    587       ELSE IF (ksbc == jp_core) THEN 
     587      ELSE IF (ksbc == jp_blk) THEN 
    588588         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    589589      ELSE IF (ksbc == jp_purecpl) THEN 
    … …  
    618618! Scale qsr and qns according to ice fraction (bulk formulae only) 
    619619 
    620       IF (ksbc == jp_core) THEN 
     620      IF (ksbc == jp_blk) THEN 
    621621         qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 
    622622         qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r6416 r6723  
    1313   !!             -   ! 2012-10  (C. Rousset)  add lim_diahsb 
    1414   !!            3.6  ! 2014-07  (M. Vancoppenolle, G. Madec, O. Marti) revise coupled interface 
     15   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk) 
    1516   !!---------------------------------------------------------------------- 
    1617#if defined key_lim3 
    … …  
    2829   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2930   USE sbc_ice         ! Surface boundary condition: ice   fields 
    30    USE sbcblk_core     ! Surface boundary condition: CORE bulk 
    31    USE sbcblk_clio     ! Surface boundary condition: CLIO bulk 
     31   USE sbcblk          ! Surface boundary condition: bulk 
    3232   USE sbccpl          ! Surface boundary condition: coupled interface 
    3333   USE albedo          ! ocean & ice albedo 
    … …  
    4747   USE limupdate2      ! update of global variables 
    4848   USE limvar          ! Ice variables switch 
    49    USE limctl          !  
     49   USE limctl          ! 
    5050   USE limmsh          ! LIM mesh 
    5151   USE limistate       ! LIM initial state 
    … …  
    5656   USE iom             ! I/O manager library 
    5757   USE prtctl          ! Print control 
    58    USE lib_fortran     !  
     58   USE lib_fortran     ! 
    5959   USE lbclnk          ! lateral boundary condition - MPP link 
    6060   USE lib_mpp         ! MPP library 
    … …  
    6262   USE timing          ! Timing 
    6363 
    64 #if defined key_bdy  
     64#if defined key_bdy 
    6565   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
    6666#endif 
    … …  
    7171   PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90 
    7272   PUBLIC sbc_lim_init ! routine called by sbcmod.F90 
    73     
     73 
    7474   !! * Substitutions 
    7575#  include "vectopt_loop_substitute.h90" 
    … …  
    8484      !!--------------------------------------------------------------------- 
    8585      !!                  ***  ROUTINE sbc_ice_lim  *** 
    86       !!                    
    87       !! ** Purpose :   update the ocean surface boundary condition via the  
    88       !!                Louvain la Neuve Sea Ice Model time stepping  
     86      !! 
     87      !! ** Purpose :   update the ocean surface boundary condition via the 
     88      !!                Louvain la Neuve Sea Ice Model time stepping 
    8989      !! 
    9090      !! ** Method  :   ice model time stepping 
    91       !!              - call the ice dynamics routine  
    92       !!              - call the ice advection/diffusion routine  
    93       !!              - call the ice thermodynamics routine  
    94       !!              - call the routine that computes mass and  
     91      !!              - call the ice dynamics routine 
     92      !!              - call the ice advection/diffusion routine 
     93      !!              - call the ice thermodynamics routine 
     94      !!              - call the routine that computes mass and 
    9595      !!                heat fluxes at the ice/ocean interface 
    96       !!              - save the outputs  
     96      !!              - save the outputs 
    9797      !!              - save the outputs for restart when necessary 
    9898      !! 
    9999      !! ** Action  : - time evolution of the LIM sea-ice model 
    100100      !!              - update all sbc variables below sea-ice: 
    101       !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx  
     101      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx 
    102102      !!--------------------------------------------------------------------- 
    103103      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    104       INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 
     104      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=4 BULK, =5 COUPLED) 
    105105      !! 
    106106      INTEGER  ::    jl                 ! dummy loop index 
    107107      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    108       REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice  
     108      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice 
    109109      !!---------------------------------------------------------------------- 
    110110 
    … …  
    119119         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 
    120120         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 
    121           
     121 
    122122         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    123123         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 
    124124         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 
    125            
     125 
    126126         ! Mask sea ice surface temperature (set to rt0 over land) 
    127127         DO jl = 1, jpl 
    128128            t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 
    129          END DO      
    130          ! 
    131          !------------------------------------------------!                                            
    132          ! --- Dynamical coupling with the atmosphere --- !                                            
     129         END DO 
     130         ! 
     131         !------------------------------------------------! 
     132         ! --- Dynamical coupling with the atmosphere --- ! 
    133133         !------------------------------------------------! 
    134134         ! It provides the following fields: 
    … …  
    136136         !----------------------------------------------------------------- 
    137137         SELECT CASE( kblk ) 
    138          CASE( jp_clio    )   ;   CALL blk_ice_clio_tau                         ! CLIO bulk formulation             
    139          CASE( jp_core    )   ;   CALL blk_ice_core_tau                         ! CORE bulk formulation 
     138         CASE( jp_blk     )   ;   CALL blk_ice_tau                              ! Bulk formulation 
    140139         CASE( jp_purecpl )   ;   CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation 
    141140         END SELECT 
    142           
     141 
    143142         IF( ln_mixcpl) THEN   ! Case of a mixed Bulk/Coupled formulation 
    144143            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice) 
    … …  
    153152         !-------------------------------------------------------! 
    154153         numit = numit + nn_fsbc                  ! Ice model time step 
    155          !                                                    
     154         ! 
    156155         CALL sbc_lim_bef                         ! Store previous ice values 
    157156         CALL sbc_lim_diag0                       ! set diag of mass, heat and salt fluxes to 0 
    … …  
    160159         IF( .NOT. lk_c1d ) THEN 
    161160            ! 
    162             CALL lim_dyn( kt )                    ! Ice dynamics    ( rheology/dynamics )    
     161            CALL lim_dyn( kt )                    ! Ice dynamics    ( rheology/dynamics ) 
    163162            ! 
    164163            CALL lim_trp( kt )                    ! Ice transport   ( Advection/diffusion ) 
    … …  
    167166            ! 
    168167#if defined key_bdy 
    169             CALL bdy_ice_lim( kt )                ! bdy ice thermo  
     168            CALL bdy_ice_lim( kt )                ! bdy ice thermo 
    170169            IF( ln_icectl )       CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    171170#endif 
    … …  
    174173            ! 
    175174         ENDIF 
    176           
     175 
    177176         ! previous lead fraction and ice volume for flux calculations 
    178          CALL sbc_lim_bef                         
     177         CALL sbc_lim_bef 
    179178         CALL lim_var_glo2eqv                     ! ht_i and ht_s for ice albedo calculation 
    180          CALL lim_var_agg(1)                      ! at_i for coupling (via pfrld)  
     179         CALL lim_var_agg(1)                      ! at_i for coupling (via pfrld) 
    181180         pfrld(:,:)   = 1._wp - at_i(:,:) 
    182181         phicif(:,:)  = vt_i(:,:) 
    183           
    184          !------------------------------------------------------!                                            
    185          ! --- Thermodynamical coupling with the atmosphere --- !                                            
     182 
     183         !------------------------------------------------------! 
     184         ! --- Thermodynamical coupling with the atmosphere --- ! 
    186185         !------------------------------------------------------! 
    187186         ! It provides the following fields: 
    … …  
    196195 
    197196         SELECT CASE( kblk ) 
    198          CASE( jp_clio )                                       ! CLIO bulk formulation 
    199             ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    200             ! (alb_ice) is computed within the bulk routine 
    201                                  CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 
    202             IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    203             IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    204          CASE( jp_core )                                       ! CORE bulk formulation 
     197         CASE( jp_blk )                                       ! bulk formulation 
    205198            ! albedo depends on cloud fraction because of non-linear spectral effects 
    206199            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    207                                  CALL blk_ice_core_flx( t_su, alb_ice ) 
     200                                 CALL blk_ice_flx( t_su, alb_ice ) 
    208201            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    209202            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    … …  
    219212         ! --- ice thermodynamics --- ! 
    220213         !----------------------------! 
    221          CALL lim_thd( kt )                         ! Ice thermodynamics       
     214         CALL lim_thd( kt )                         ! Ice thermodynamics 
    222215         ! 
    223216         CALL lim_update2( kt )                     ! Corrections 
    … …  
    225218         CALL lim_sbc_flx( kt )                     ! Update surface ocean mass, heat and salt fluxes 
    226219         ! 
    227          IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs  
    228          ! 
    229          CALL lim_wri( 1 )                          ! Ice outputs  
     220         IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs 
     221         ! 
     222         CALL lim_wri( 1 )                          ! Ice outputs 
    230223         ! 
    231224         IF( kt == nit000 .AND. ln_rstart )   & 
    232225            &             CALL iom_close( numrir )  ! close input ice restart file 
    233226         ! 
    234          IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file  
     227         IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file 
    235228         ! 
    236229         IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash 
    … …  
    248241      ! 
    249242   END SUBROUTINE sbc_ice_lim 
    250     
     243 
    251244 
    252245   SUBROUTINE sbc_lim_init 
    … …  
    259252      !!---------------------------------------------------------------------- 
    260253      IF(lwp) WRITE(numout,*) 
    261       IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition'  
     254      IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 
    262255      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping' 
    263256      ! 
    264       !                                ! Open the reference and configuration namelist files and namelist output file  
    265       CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )  
     257      !                                ! Open the reference and configuration namelist files and namelist output file 
     258      CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    266259      CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    267260      IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 
    … …  
    308301      CALL lim_var_glo2eqv 
    309302      ! 
    310       CALL lim_sbc_init                 ! ice surface boundary condition    
     303      CALL lim_sbc_init                 ! ice surface boundary condition 
    311304      ! 
    312305      fr_i(:,:)     = at_i(:,:)         ! initialisation of sea-ice fraction 
    … …  
    318311            ELSE                             ;  rn_amax_2d(ji,jj) = rn_amax_s  ! SH 
    319312            ENDIF 
    320         ENDDO 
    321       ENDDO  
    322       ! 
    323       nstart = numit  + nn_fsbc       
    324       nitrun = nitend - nit000 + 1  
    325       nlast  = numit  + nitrun  
     313         END DO 
     314      END DO 
     315      ! 
     316      nstart = numit  + nn_fsbc 
     317      nitrun = nitend - nit000 + 1 
     318      nlast  = numit  + nitrun 
    326319      ! 
    327320      IF( nstock == 0 )   nstock = nlast + 1 
    … …  
    333326      !!------------------------------------------------------------------- 
    334327      !!                  ***  ROUTINE ice_run *** 
    335       !!                  
     328      !! 
    336329      !! ** Purpose :   Definition some run parameter for ice model 
    337330      !! 
    338       !! ** Method  :   Read the namicerun namelist and check the parameter  
     331      !! ** Method  :   Read the namicerun namelist and check the parameter 
    339332      !!              values called at the first timestep (nit000) 
    340333      !! 
    … …  
    343336      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    344337      NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir,  & 
    345          &                ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt   
     338         &                ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt 
    346339      !!------------------------------------------------------------------- 
    347       !                     
     340      ! 
    348341      REWIND( numnam_ice_ref )              ! Namelist namicerun in reference namelist : Parameters for ice 
    349342      READ  ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 
    … …  
    363356         WRITE(numout,*) '   number of snow layers                                   = ', nlay_s 
    364357         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
    365          WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n  
     358         WRITE(numout,*) '   maximum ice concentration for NH                        = ', rn_amax_n 
    366359         WRITE(numout,*) '   maximum ice concentration for SH                        = ', rn_amax_s 
    367360         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
    … …  
    373366      ! 
    374367      ! sea-ice timestep and inverse 
    375       rdt_ice   = nn_fsbc * rdt   
    376       r1_rdtice = 1._wp / rdt_ice  
     368      rdt_ice   = nn_fsbc * rdt 
     369      r1_rdtice = 1._wp / rdt_ice 
    377370 
    378371      ! inverse of nlay_i and nlay_s 
    … …  
    421414      ! 
    422415      !---------------------------------- 
    423       !- Thickness categories boundaries  
     416      !- Thickness categories boundaries 
    424417      !---------------------------------- 
    425418      IF(lwp) WRITE(numout,*) 
    … …  
    443436         zalpha = 0.05_wp 
    444437         zhmax  = 3._wp * rn_himean 
    445          DO jl = 1, jpl  
     438         DO jl = 1, jpl 
    446439            znum = jpl * ( zhmax+1 )**zalpha 
    447440            zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) 
    … …  
    462455   END SUBROUTINE lim_itd_init 
    463456 
    464     
     457 
    465458   SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice ,    & 
    466459      &                    pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
    467460      !!--------------------------------------------------------------------- 
    468461      !!                  ***  ROUTINE ice_lim_flx  *** 
    469       !!                    
     462      !! 
    470463      !! ** Purpose :   update the ice surface boundary condition by averaging and / or 
    471       !!                redistributing fluxes on ice categories                    
    472       !! 
    473       !! ** Method  :   average then redistribute  
    474       !! 
    475       !! ** Action  :    
     464      !!                redistributing fluxes on ice categories 
     465      !! 
     466      !! ** Method  :   average then redistribute 
     467      !! 
     468      !! ** Action  : 
    476469      !!--------------------------------------------------------------------- 
    477       INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ;  
    478       !                                                         ! =1 average and redistribute ; =2 redistribute 
    479       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature  
     470      INTEGER                   , INTENT(in   ) ::   k_limflx   ! =-1 do nothing; =0 average ; 
     471      !                                                         ! = 1 average and redistribute ; =2 redistribute 
     472      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptn_ice    ! ice surface temperature 
    480473      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb_ice   ! ice albedo 
    481474      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqns_ice   ! non solar flux 
    … …  
    526519         CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m ) 
    527520         ! 
    528          zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) )  
    529          ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) )  
     521         zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 
     522         ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) ) 
    530523         DO jl = 1, jpl 
    531524            pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
    532525            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
    533             pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )  
     526            pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 
    534527         END DO 
    535528         ! 
    … …  
    546539      !!                  ***  ROUTINE sbc_lim_bef  *** 
    547540      !! 
    548       !! ** purpose :  store ice variables at "before" time step  
     541      !! ** purpose :  store ice variables at "before" time step 
    549542      !!---------------------------------------------------------------------- 
    550543      a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area 
    551544      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy 
    552545      v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume 
    553       v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume  
     546      v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
    554547      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy 
    555548      smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content 
    … …  
    557550      u_ice_b(:,:)     = u_ice(:,:) 
    558551      v_ice_b(:,:)     = v_ice(:,:) 
    559       !       
     552      ! 
    560553   END SUBROUTINE sbc_lim_bef 
    561554 
    … …  
    569562      !!---------------------------------------------------------------------- 
    570563      sfx    (:,:) = 0._wp   ; 
    571       sfx_bri(:,:) = 0._wp   ;  
     564      sfx_bri(:,:) = 0._wp   ; 
    572565      sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
    573566      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
    … …  
    580573      wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
    581574      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
    582       wfx_spr(:,:) = 0._wp   ;    
    583       ! 
    584       hfx_thd(:,:) = 0._wp   ;    
     575      wfx_spr(:,:) = 0._wp   ; 
     576      ! 
     577      hfx_thd(:,:) = 0._wp   ; 
    585578      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
    586579      hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp 
    587580      hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp 
    588581      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
    589       hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp  
     582      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
    590583      hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
    591584      hfx_err_dif(:,:) = 0._wp 
    … …  
    600593   END SUBROUTINE sbc_lim_diag0 
    601594 
    602       
     595 
    603596   FUNCTION fice_cell_ave ( ptab ) 
    604597      !!-------------------------------------------------------------------------- 
    … …  
    608601      REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 
    609602      INTEGER :: jl ! Dummy loop index 
    610        
    611       fice_cell_ave (:,:) = 0.0_wp 
     603 
     604      fice_cell_ave (:,:) = 0._wp 
    612605      DO jl = 1, jpl 
    613606         fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl) 
    614607      END DO 
    615        
     608 
    616609   END FUNCTION fice_cell_ave 
    617     
    618     
     610 
     611 
    619612   FUNCTION fice_ice_ave ( ptab ) 
    620613      !!-------------------------------------------------------------------------- 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r6140 r6723  
    2424   USE sbc_oce          ! Surface boundary condition: ocean fields 
    2525   USE sbc_ice          ! Surface boundary condition: ice   fields 
    26    USE sbcblk_core      ! Surface boundary condition: CORE bulk 
    27    USE sbcblk_clio      ! Surface boundary condition: CLIO bulk 
     26   USE sbcblk           ! Surface boundary condition: bulk 
    2827   USE sbccpl           ! Surface boundary condition: coupled interface 
    2928   USE albedo 
    … …  
    9392      !!--------------------------------------------------------------------- 
    9493      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    95       INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled ) 
     94      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =4 bulk ; =5 coupled ) 
    9695      !! 
    9796      INTEGER  ::   ji, jj   ! dummy loop indices 
    … …  
    161160 
    162161         SELECT CASE( ksbc ) 
    163          CASE( jp_core , jp_purecpl )   ! CORE and COUPLED bulk formulations 
     162         CASE( jp_blk , jp_purecpl )   ! BULK and COUPLED bulk formulations 
    164163 
    165164            ! albedo depends on cloud fraction because of non-linear spectral effects 
    166165            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    167             ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    168             ! (zalb_ice) is computed within the bulk routine 
    169166 
    170167         END SELECT 
    … …  
    184181         ! 
    185182         SELECT CASE( ksbc ) 
    186          CASE( jp_clio )           ! CLIO bulk formulation 
    187 !           CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
    188 !              &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    189 !              &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    190 !              &                      tprecip    , sprecip    ,                         & 
    191 !              &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    192             CALL blk_ice_clio_tau 
    193             CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 
    194  
    195          CASE( jp_core )           ! CORE bulk formulation 
    196             CALL blk_ice_core_tau 
    197             CALL blk_ice_core_flx( zsist, zalb_ice ) 
    198  
     183         ! 
     184         CASE( jp_blk )           ! Bulk formulation 
     185            CALL blk_ice_tau 
     186            CALL blk_ice_flx( zsist, zalb_ice ) 
     187            ! 
    199188         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    200189            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
     190            ! 
    201191         END SELECT 
    202192          

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r6460 r6723  
    1313   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    1414   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes 
    15    !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting                     
     15   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting 
     16   !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation 
    1617   !!---------------------------------------------------------------------- 
    1718 
    … …  
    3031   USE sbcana         ! surface boundary condition: analytical formulation 
    3132   USE sbcflx         ! surface boundary condition: flux formulation 
    32    USE sbcblk_clio    ! surface boundary condition: bulk formulation : CLIO 
    33    USE sbcblk_core    ! surface boundary condition: bulk formulation : CORE 
    34    USE sbcblk_mfs     ! surface boundary condition: bulk formulation : MFS 
     33   USE sbcblk         ! surface boundary condition: bulk formulation 
    3534   USE sbcice_if      ! surface boundary condition: ice-if sea-ice model 
    3635   USE sbcice_lim     ! surface boundary condition: LIM 3.0 sea-ice model 
    … …  
    5554   USE timing         ! Timing 
    5655 
    57    USE diurnal_bulk, ONLY: & 
    58       & ln_diurnal_only  
     56   USE diurnal_bulk, ONLY:   ln_diurnal_only 
    5957 
    6058   IMPLICIT NONE 
    … …  
    6361   PUBLIC   sbc        ! routine called by step.F90 
    6462   PUBLIC   sbc_init   ! routine called by opa.F90 
    65     
     63 
    6664   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations) 
    67        
     65 
    6866   !!---------------------------------------------------------------------- 
    69    !! NEMO/OPA 4.0 , NEMO-consortium (2011)  
     67   !! NEMO/OPA 4.0 , NEMO-consortium (2016)  
    7068   !! $Id$ 
    7169   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    8785      INTEGER ::   icpt   ! local integer 
    8886      !! 
    89       NAMELIST/namsbc/ nn_fsbc  , ln_ana   , ln_flx, ln_blk_clio, ln_blk_core, ln_blk_mfs,   & 
    90          &             ln_cpl   , ln_mixcpl, nn_components      , nn_limflx  ,               & 
    91          &             ln_traqsr, ln_dm2dc ,                                                 &   
    92          &             nn_ice   , nn_ice_embd,                                               & 
    93          &             ln_rnf   , ln_ssr   , ln_isf   , nn_fwb    , ln_apr_dyn,              & 
    94          &             ln_wave  ,                                                            & 
    95          &             nn_lsm    
     87      NAMELIST/namsbc/ nn_fsbc  , ln_ana   , ln_flx, ln_blk, ln_cpl   , ln_mixcpl,        & 
     88         &             nn_components      , nn_limflx  ,                                  & 
     89         &             ln_traqsr, ln_dm2dc ,                                              & 
     90         &             nn_ice   , nn_ice_embd,                                            & 
     91         &             ln_rnf   , ln_ssr   , ln_isf   , nn_fwb    , ln_apr_dyn,           & 
     92         &             ln_wave  ,                                                         & 
     93         &             nn_lsm 
    9694      INTEGER  ::   ios 
    9795      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm 
    … …  
    116114      !                          ! overwrite namelist parameter using CPP key information 
    117115      IF( Agrif_Root() ) THEN                ! AGRIF zoom 
    118         IF( lk_lim2 )   nn_ice      = 2 
    119         IF( lk_lim3 )   nn_ice      = 3 
    120         IF( lk_cice )   nn_ice      = 4 
     116         IF( lk_lim2 )   nn_ice      = 2 
     117         IF( lk_lim3 )   nn_ice      = 3 
     118         IF( lk_cice )   nn_ice      = 4 
    121119      ENDIF 
    122120      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration 
    123           ln_ana      = .TRUE.    
    124           nn_ice      =   0 
     121         ln_ana      = .TRUE. 
     122         nn_ice      =   0 
    125123      ENDIF 
    126124      ! 
    … …  
    131129         WRITE(numout,*) '              analytical formulation                     ln_ana        = ', ln_ana 
    132130         WRITE(numout,*) '              flux       formulation                     ln_flx        = ', ln_flx 
    133          WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio   = ', ln_blk_clio 
    134          WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core   = ', ln_blk_core 
    135          WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs    = ', ln_blk_mfs 
     131         WRITE(numout,*) '              bulk       formulation                     ln_blk        = ', ln_blk 
    136132         WRITE(numout,*) '           Type of coupling (Ocean/Ice/Atmosphere) : ' 
    137133         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
    … …  
    141137         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx 
    142138         WRITE(numout,*) '           Sea-ice : ' 
    143          WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice  
     139         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice 
    144140         WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd 
    145141         WRITE(numout,*) '           Misc. options of sbc : ' 
    146142         WRITE(numout,*) '              Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr 
    147          WRITE(numout,*) '                 daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc  
     143         WRITE(numout,*) '                 daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc 
    148144         WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr 
    149145         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb 
    … …  
    153149         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea     = ', nn_closea 
    154150         WRITE(numout,*) '              nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
    155          WRITE(numout,*) '              surface wave                               ln_wave       = ', ln_wave   
     151         WRITE(numout,*) '              surface wave                               ln_wave       = ', ln_wave 
    156152      ENDIF 
    157153      ! 
    … …  
    160156         SELECT CASE ( nn_limflx )        ! LIM3 Multi-category heat flux formulation 
    161157         CASE ( -1 )   ;   WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) ' 
    162          CASE ( 0  )   ;   WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) '  
     158         CASE ( 0  )   ;   WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) ' 
    163159         CASE ( 1  )   ;   WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) ' 
    164160         CASE ( 2  )   ;   WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) ' 
    … …  
    185181 
    186182      !                          ! Checks: 
    187       IF( .NOT. ln_isf ) THEN                      ! variable initialisation if no ice shelf  
     183      IF( .NOT. ln_isf ) THEN                      ! variable initialisation if no ice shelf 
    188184         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 
    189185         fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp 
    … …  
    192188      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! no ice in the domain, ice fraction is always zero 
    193189 
    194       sfx(:,:) = 0._wp                             ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
    195                                                    ! only if sea-ice is present 
    196   
     190      sfx(:,:) = 0._wp                             ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) 
     191      !                                            ! only if sea-ice is present 
     192 
    197193      fmmflx(:,:) = 0._wp                          ! freezing-melting array initialisation 
    198        
     194 
    199195      taum(:,:) = 0._wp                            ! Initialise taum for use in gls in case of reduced restart 
    200196 
    201       !                                            ! restartability    
    202       IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   & 
     197      !                                            ! restartability 
     198      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk .OR. ln_cpl ) )   & 
    203199         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
    204       IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   & 
    205          &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 
     200      IF( nn_ice == 4 .AND. .NOT.( ln_blk .OR. ln_cpl ) )   & 
     201         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk or ln_cpl' ) 
    206202      IF( nn_ice == 4 .AND. lk_agrif )   & 
    207203         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
    … …  
    217213      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    218214 
    219       IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   & 
    220          &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 
    221        
     215      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa )   & 
     216         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or the bulk formulation' ) 
     217 
    222218      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    223219      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 
    … …  
    226222      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation 
    227223      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
    228       IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation 
    229       IF( ln_blk_core     ) THEN   ;   nsbc = jp_core    ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk            formulation 
    230       IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation 
     224      IF( ln_blk          ) THEN   ;   nsbc = jp_blk     ; icpt = icpt + 1   ;   ENDIF       ! bulk                 formulation 
    231225      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
    232226      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation 
    … …  
    242236         CASE( jp_ana     )   ;   WRITE(numout,*) '   analytical formulation' 
    243237         CASE( jp_flx     )   ;   WRITE(numout,*) '   flux formulation' 
    244          CASE( jp_clio    )   ;   WRITE(numout,*) '   CLIO bulk formulation' 
    245          CASE( jp_core    )   ;   WRITE(numout,*) '   CORE bulk formulation' 
     238         CASE( jp_blk     )   ;   WRITE(numout,*) '   bulk formulation' 
    246239         CASE( jp_purecpl )   ;   WRITE(numout,*) '   pure coupled formulation' 
    247          CASE( jp_mfs     )   ;   WRITE(numout,*) '   MFS Bulk formulation' 
    248240         CASE( jp_none    )   ;   WRITE(numout,*) '   OPA coupled to SAS via oasis' 
    249241            IF( ln_mixcpl )       WRITE(numout,*) '       + forced-coupled mixed formulation' 
    … …  
    269261      ! 
    270262      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
    271           MOD( nstock             , nn_fsbc) /= 0 ) THEN  
     263          MOD( nstock             , nn_fsbc) /= 0 ) THEN 
    272264         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
    273265            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
    … …  
    297289      !!--------------------------------------------------------------------- 
    298290      !!                    ***  ROUTINE sbc  *** 
    299       !!               
     291      !! 
    300292      !! ** Purpose :   provide at each time-step the ocean surface boundary 
    301293      !!                condition (momentum, heat and freshwater fluxes) 
    302294      !! 
    303       !! ** Method  :   blah blah  to be written ?????????  
     295      !! ** Method  :   blah blah  to be written ????????? 
    304296      !!                CAUTION : never mask the surface stress field (tke sbc) 
    305297      !! 
    306       !! ** Action  : - set the ocean surface boundary condition at before and now  
    307       !!                time step, i.e.   
     298      !! ** Action  : - set the ocean surface boundary condition at before and now 
     299      !!                time step, i.e. 
    308300      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b 
    309301      !!                utau  , vtau  , qns  , qsr  , emp  , sfx  , qrp  , erp 
    310302      !!              - updte the ice fraction : fr_i 
    311303      !!---------------------------------------------------------------------- 
    312       INTEGER, INTENT(in) ::   kt       ! ocean time step 
     304      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     305      ! 
     306      LOGICAL ::   ll_sas, ll_opa   ! local logical 
    313307      !!--------------------------------------------------------------------- 
    314308      ! 
    … …  
    332326      !                                            ! ---------------------------------------- ! 
    333327      ! 
    334       IF( nn_components /= jp_iam_sas )   CALL sbc_ssm ( kt )  ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    335       !                                                        ! averaged over nf_sbc time-step 
    336       IF( ln_wave                     )   CALL sbc_wave( kt )  ! surface waves 
    337        
    338        
    339                                                    !==  sbc formulation  ==! 
    340                                                              
     328      ll_sas = nn_components == jp_iam_sas               ! component flags 
     329      ll_opa = nn_components == jp_iam_opa 
     330      ! 
     331      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt )            ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
     332      IF( ln_wave     )   CALL sbc_wave( kt )            ! surface waves 
     333 
     334      ! 
     335      !                                            !==  sbc formulation  ==! 
     336      !                                                    
    341337      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    342338      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    343       CASE( jp_gyre  )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
    344       CASE( jp_ana   )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
    345       CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    346       CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    347       CASE( jp_core  )    
    348          IF( nn_components == jp_iam_sas ) & 
    349             &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA  
    350                              CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    351                                                                         ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m) 
    352       CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
    353                                                                         ! 
    354       CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
    355       CASE( jp_none  )  
    356          IF( nn_components == jp_iam_opa )   & 
    357             &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
     339      CASE( jp_gyre    )   ;   CALL sbc_gyre  ( kt )                     ! analytical formulation : GYRE configuration 
     340      CASE( jp_ana     )   ;   CALL sbc_ana   ( kt )                     ! analytical formulation : uniform sbc 
     341      CASE( jp_flx     )   ;   CALL sbc_flx   ( kt )                     ! flux formulation 
     342      CASE( jp_blk     ) 
     343         IF( ll_sas    )       CALL sbc_cpl_rcv( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA 
     344                               CALL sbc_blk    ( kt )                    ! bulk formulation for the ocean 
     345                               ! 
     346      CASE( jp_purecpl )   ;   CALL sbc_cpl_rcv( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
     347      CASE( jp_none    ) 
     348         IF( ll_opa    )       CALL sbc_cpl_rcv( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
    358349      END SELECT 
    359350 
    360       IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
     351      IF( ln_mixcpl )          CALL sbc_cpl_rcv( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
    361352 
    362353      ! 
    … …  
    368359      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    369360      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
    370       END SELECT                                               
     361      END SELECT 
    371362 
    372363      IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs 
    … …  
    375366 
    376367      IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 
    377   
     368 
    378369      IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term 
    379370 
    380371      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
    381372 
    382       ! treatment of closed sea in the model domain  
    383       ! (update freshwater fluxes) 
     373      ! treatment of closed sea in the model domain   (update freshwater fluxes) 
    384374      ! Should not be ran if ln_diurnal_only 
    385       IF( .NOT.(ln_diurnal_only) .AND. (nn_closea == 1) )   CALL sbc_clo( kt )    
     375      IF( .NOT.(ln_diurnal_only) .AND. (nn_closea == 1) )   CALL sbc_clo( kt ) 
    386376 
    387377!RBbug do not understand why see ticket 667 
    … …  
    392382         !                                             ! ---------------------------------------- ! 
    393383         IF( ln_rstart .AND.    &                               !* Restart: read in restart file 
    394             & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN  
     384            & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
    395385            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file' 
    396386            CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b )   ! before i-stress  (U-point) 
    … …  
    408398         ELSE                                                   !* no restart: set from nit000 values 
    409399            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000' 
    410             utau_b(:,:) = utau(:,:)  
     400            utau_b(:,:) = utau(:,:) 
    411401            vtau_b(:,:) = vtau(:,:) 
    412402            qns_b (:,:) = qns (:,:) 
    413             emp_b (:,:) = emp(:,:) 
    414             sfx_b (:,:) = sfx(:,:) 
     403            emp_b (:,:) = emp (:,:) 
     404            sfx_b (:,:) = sfx (:,:) 
    415405         ENDIF 
    416406      ENDIF 
    … …  
    436426         CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux 
    437427         CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 
    438          CALL iom_put( "saltflx", sfx  )                        ! downward salt flux   
    439                                                                 ! (includes virtual salt flux beneath ice  
    440                                                                 ! in linear free surface case) 
     428         CALL iom_put( "saltflx", sfx  )                        ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 
    441429         CALL iom_put( "fmmflx", fmmflx  )                      ! Freezing-melting water flux 
    442          CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux  
     430         CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux 
    443431         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    444432         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    445          IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
    446          CALL iom_put( "taum"  , taum       )                   ! wind stress module  
     433         IF( nn_ice > 0 .OR. ll_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
     434         CALL iom_put( "taum"  , taum       )                   ! wind stress module 
    447435         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 
    448436      ENDIF 
    449437      ! 
    450       CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at  
    451       CALL iom_put( "vtau", vtau )   ! j-wind stress    each time step in sea-ice) 
     438      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at each time step in sea-ice) 
     439      CALL iom_put( "vtau", vtau )   ! j-wind stress 
    452440      ! 
    453441      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r6489 r6723  
    8888            !                                             ! ----------------------------------------------- ! 
    8989            IF(lwp) WRITE(numout,*) 
    90             IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values' 
     90            IF(lwp) WRITE(numout,*) 'sbc_ssm : mean fields initialised to instantaneous values' 
     91            IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    9192            zcoef = REAL( nn_fsbc - 1, wp ) 
    9293            ssu_m(:,:) = zcoef * ub(:,:,1) 
    … …  
    194195         ! 
    195196         IF(lwp) WRITE(numout,*) 
    196          IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields, nn_fsbc=1 : instantaneous values' 
    197          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     197         IF(lwp) WRITE(numout,*) 'sbc_ssm_init : sea surface mean fields, nn_fsbc=1 : instantaneous values' 
     198         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
    198199         ! 
    199200      ELSE 
    200201         !                
    201202         IF(lwp) WRITE(numout,*) 
    202          IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields' 
    203          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     203         IF(lwp) WRITE(numout,*) 'sbc_ssm_init : sea surface mean fields' 
     204         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 
    204205         ! 
    205206         IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 

  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r6140 r6723  
    2525   PRIVATE 
    2626 
    27    PUBLIC   sbc_wave    ! routine called in sbc_blk_core or sbc_blk_mfs 
     27   PUBLIC   sbc_wave    ! routine called in sbc_blk 
    2828    
    2929   INTEGER , PARAMETER ::   jpfld  = 3   ! maximum number of files to read for srokes drift 
    … …  
    9494         IF( .NOT.( ln_cdgw .OR. ln_sdw ) )    & 
    9595            &  CALL ctl_warn( 'ln_sbcwave=T but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' ) 
    96          IF( ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )   &        
    97             &  CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core') 
     96         IF( ln_cdgw .AND. .NOT.ln_blk )   &        
     97            &  CALL ctl_stop( 'drag coefficient read from wave model definable only with bulk formulae') 
    9898         ! 
    9999         IF( ln_cdgw ) THEN 
Note: See TracChangeset for help on using the changeset viewer.