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 2198 – NEMO

Changeset 2198


Ignore:
Timestamp:
2010-10-11T13:09:49+02:00 (13 years ago)
Author:
smasson
Message:

merge dev_r2174_DCY into DEV_r2106_LOCEAN2010

Location:
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r1951 r2198  
    1212   !!            3.0  !  2006-06  (G. Madec) sbc rewritting    
    1313   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put 
     14   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle 
    1415   !!---------------------------------------------------------------------- 
    1516 
     
    2627   USE fldread         ! read input fields 
    2728   USE sbc_oce         ! Surface boundary condition: ocean fields 
     29   USE sbcdcy          ! surface boundary condition: diurnal cycle 
    2830   USE iom             ! I/O manager library 
    2931   USE in_out_manager  ! I/O manager 
     
    3436   USE sbc_ice         ! Surface boundary condition: ice fields 
    3537#endif 
    36  
    3738 
    3839   IMPLICIT NONE 
     
    6263   REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice 
    6364 
    64    !                                !!* Namelist namsbc_core : CORE bulk parameters 
    65    LOGICAL  ::   ln_2m     = .FALSE.     ! logical flag for height of air temp. and hum 
    66    LOGICAL  ::   ln_taudif = .FALSE.     ! logical flag to use the "mean of stress module - module of mean stress" data 
    67    REAL(wp) ::   rn_pfac   = 1.          ! multiplication factor for precipitation 
     65   !                                  !!* Namelist namsbc_core : CORE bulk parameters 
     66   LOGICAL  ::   ln_2m     = .FALSE.   ! logical flag for height of air temp. and hum 
     67   LOGICAL  ::   ln_taudif = .FALSE.   ! logical flag to use the "mean of stress module - module of mean stress" data 
     68   REAL(wp) ::   rn_pfac   = 1.        ! multiplication factor for precipitation 
    6869 
    6970   !! * Substitutions 
     
    7172#  include "vectopt_loop_substitute.h90" 
    7273   !!---------------------------------------------------------------------- 
    73    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     74   !! NEMO/OPA 3.3 , NEMO-consortium (2010)  
    7475   !! $Id$ 
    7576   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7677   !!---------------------------------------------------------------------- 
    77  
    7878CONTAINS 
    7979 
     
    144144         sn_tdif = FLD_N( 'taudif'  ,    24     ,  'taudif'  ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
    145145         ! 
    146          REWIND( numnam )                    ! ... read in namlist namsbc_core 
     146         REWIND( numnam )                          ! read in namlist namsbc_core 
    147147         READ  ( numnam, namsbc_core ) 
    148          ! 
    149          ! store namelist information in an array 
     148         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
     149         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &  
     150            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )  
     151         IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN 
     152            CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   & 
     153                 &         '              ==> We force time interpolation = .false. for qsr' ) 
     154            sn_qsr%ln_tint = .false. 
     155         ENDIF 
     156         !                                         ! store namelist information in an array 
    150157         slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj 
    151158         slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw 
     
    153160         slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    154161         slf_i(jp_tdif) = sn_tdif 
    155          ! 
    156          ! do we use HF tau information? 
    157          lhftau = ln_taudif 
     162         !                  
     163         lhftau = ln_taudif                        ! do we use HF tau information? 
    158164         jfld = jpfld - COUNT( (/.NOT. lhftau/) ) 
    159165         ! 
    160          ! set sf structure 
    161          ALLOCATE( sf(jfld), STAT=ierror ) 
     166         ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure 
    162167         IF( ierror > 0 ) THEN 
    163168            CALL ctl_stop( 'sbc_blk_core: unable to allocate sf structure' )   ;   RETURN 
     
    167172            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    168173         END DO 
    169          ! 
    170          ! fill sf with slf_i and control print 
    171          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulattion for ocean surface boundary condition', 'namsbc_core' ) 
     174         !                                         ! fill sf with slf_i and control print 
     175         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' ) 
    172176         ! 
    173177      ENDIF 
    174178 
    175       CALL fld_read( kt, nn_fsbc, sf )                   ! input fields provided at the current time-step 
     179                       CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step 
     180 
     181      IF( ln_dm2dc )   CALL sbc_dcy ( kt , sf(jp_qsr)%fnow )   ! modify now Qsr to include the diurnal cycle 
    176182 
    177183#if defined key_lim3 
    178       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 
     184      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)                  ! LIM3: make Tair available in sea-ice 
    179185#endif 
    180  
    181       IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    182           CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m )   ! compute the surface ocean fluxes using CLIO bulk formulea 
    183       ENDIF 
    184       !                                                  ! using CORE bulk formulea 
     186      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
     187      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 
     188      ! 
    185189   END SUBROUTINE sbc_blk_core 
    186190    
  • branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcflx.F90

    r1951 r2198  
    44   !! Ocean forcing:  momentum, heat and freshwater flux formulation 
    55   !!===================================================================== 
    6    !! History :  9.0   !  06-06  (G. Madec)  Original code 
     6   !! History :  1.0  !  2006-06  (G. Madec)  Original code 
     7   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle 
    78   !!---------------------------------------------------------------------- 
    89 
    910   !!---------------------------------------------------------------------- 
    1011   !!   namflx   : flux formulation namlist 
    11    !!   sbc_flx  : flux formulation as ocean surface boundary condition 
    12    !!              (forced mode, fluxes read in NetCDF files) 
    13    !!---------------------------------------------------------------------- 
    14    !! question diverses 
    15    !!  *   ajouter un test sur la division entier de freqh et rdttra ??? 
    16    !!  **  ajoute dans namelist: 1 year forcing files 
    17    !!                         or forcing file starts at the begining of the run 
    18    !!  *** we assume that the forcing file start and end with the previous 
    19    !!      year last record and the next year first record (useful for 
    20    !!      time interpolation, required even if no time interp???) 
    21    !!  *   ajouter un test sur la division de la frequence en pas de temps 
    22    !!  ==> daymod ajout de nsec_year = number of second since the begining of the year 
    23    !!      assumed to be 0 at 0h january the 1st (i.e. 24h december the 31) 
    24    !! 
    25    !!  *** regrouper dtatem et dtasal 
     12   !!   sbc_flx  : flux formulation as ocean surface boundary condition (forced mode, fluxes read in NetCDF files) 
    2613   !!---------------------------------------------------------------------- 
    2714   USE oce             ! ocean dynamics and tracers 
    2815   USE dom_oce         ! ocean space and time domain 
    29    USE sbc_oce         ! Surface boundary condition: ocean fields 
     16   USE sbc_oce         ! surface boundary condition: ocean fields 
     17   USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr 
    3018   USE phycst          ! physical constants 
    3119   USE fldread         ! read input fields 
     
    5240#  include "vectopt_loop_substitute.h90" 
    5341   !!---------------------------------------------------------------------- 
    54    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     42   !! NEMO/OPA 3.3 , NEMO-consortium (2010)  
    5543   !! $Id$ 
    5644   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5745   !!---------------------------------------------------------------------- 
    58  
    5946CONTAINS 
    6047 
     
    9885      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 
    9986      !!--------------------------------------------------------------------- 
    100       !                                         ! ====================== ! 
    101       IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    102          !                                      ! ====================== ! 
     87      ! 
     88      IF( kt == nit000 ) THEN                ! First call kt=nit000   
    10389         ! set file information 
    10490         cn_dir = './'        ! directory in which the model is executed 
    10591         ! ... default values (NB: frequency positive => hours, negative => months) 
    106          !              !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    107          !              !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    108          sn_utau = FLD_N(   'utau'  ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
    109          sn_vtau = FLD_N(   'vtau'  ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
    110          sn_qtot = FLD_N(   'qtot'  ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
    111          sn_qsr  = FLD_N(   'qsr'   ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
    112          sn_emp  = FLD_N(   'emp'   ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
    113  
    114          REWIND ( numnam )               ! ... read in namlist namflx 
     92         !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
     93         !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     ! 
     94         sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     95         sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     96         sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     97         sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     98         sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        ) 
     99         ! 
     100         REWIND ( numnam )                         ! read in namlist namflx 
    115101         READ   ( numnam, namsbc_flx )  
    116  
    117          ! store namelist information in an array 
     102         ! 
     103         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
     104         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
     105            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' )  
     106         ! 
     107         !                                         ! store namelist information in an array 
    118108         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau 
    119109         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr  
    120110         slf_i(jp_emp ) = sn_emp 
    121  
    122          ! set sf structure 
    123          ALLOCATE( sf(jpfld), STAT=ierror ) 
     111         ! 
     112         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
    124113         IF( ierror > 0 ) THEN    
    125114            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
     
    129118            ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 
    130119         END DO 
    131  
    132  
    133          ! fill sf with slf_i and control print 
     120         !                                         ! fill sf with slf_i and control print 
    134121         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 
    135122         ! 
    136123      ENDIF 
    137124 
    138       CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the 
    139       !                                          ! input fields at the current time-step 
     125                       CALL fld_read( kt, nn_fsbc, sf )       ! input fields provided at the current time-step 
     126       
     127      IF( ln_dm2dc )   CALL sbc_dcy( kt , sf(jp_qsr)%fnow )   ! modify now Qsr to include the diurnal cycle 
    140128 
    141       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    142          ! 
    143          ! set the ocean fluxes from read fields 
     129      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                    ! update ocean fluxes at each SBC frequency 
    144130!CDIR COLLAPSE 
    145          DO jj = 1, jpj 
     131         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    146132            DO ji = 1, jpi 
    147133               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     
    152138            END DO 
    153139         END DO 
    154           
    155          ! module of wind stress and wind speed at T-point 
    156          zcoef = 1. / ( zrhoa * zcdrag )  
     140         !                                                        ! module of wind stress and wind speed at T-point 
     141         zcoef = 1. / ( zrhoa * zcdrag ) 
    157142!CDIR NOVERRCHK 
    158143         DO jj = 2, jpjm1 
     
    168153         CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
    169154 
    170          ! Initialization of emps (when no ice model) 
    171          emps(:,:) = emp (:,:)  
     155         emps(:,:) = emp (:,:)                                    ! Initialization of emps (needed when no ice model) 
    172156                   
    173          ! control print (if less than 100 time-step asked) 
    174          IF( nitend-nit000 <= 100 .AND. lwp ) THEN 
     157         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
    175158            WRITE(numout,*)  
    176159            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
  • branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcmod.F90

    r2148 r2198  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-07  (G. Madec)  Original code 
    7    !!            3.1  !  2008-08  (S. Masson, E. Maisonnave, G. Madec) coupled interface 
     7   !!            3.1  !  2008-08  (S. Masson, A. Caubel, E. Maisonnave, G. Madec) coupled interface 
    88   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps 
     9   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle 
    910   !!---------------------------------------------------------------------- 
    1011 
     
    1314   !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions 
    1415   !!---------------------------------------------------------------------- 
    15    USE oce             ! ocean dynamics and tracers 
    16    USE dom_oce         ! ocean space and time domain 
    17    USE phycst          ! physical constants 
    18  
    19    USE sbc_oce         ! Surface boundary condition: ocean fields 
    20    USE sbc_ice         ! Surface boundary condition: ice fields 
    21    USE sbcssm          ! surface boundary condition: sea-surface mean variables 
    22    USE sbcana          ! surface boundary condition: analytical formulation 
    23    USE sbcflx          ! surface boundary condition: flux formulation 
    24    USE sbcblk_clio     ! surface boundary condition: bulk formulation : CLIO 
    25    USE sbcblk_core     ! surface boundary condition: bulk formulation : CORE 
    26    USE sbcice_if       ! surface boundary condition: ice-if sea-ice model 
    27    USE sbcice_lim      ! surface boundary condition: LIM 3.0 sea-ice model 
    28    USE sbcice_lim_2    ! surface boundary condition: LIM 2.0 sea-ice model 
    29    USE sbccpl          ! surface boundary condition: coupled florulation 
     16   USE oce              ! ocean dynamics and tracers 
     17   USE dom_oce          ! ocean space and time domain 
     18   USE phycst           ! physical constants 
     19   USE sbc_oce          ! Surface boundary condition: ocean fields 
     20   USE sbc_ice          ! Surface boundary condition: ice fields 
     21   USE sbcssm           ! surface boundary condition: sea-surface mean variables 
     22   USE sbcana           ! surface boundary condition: analytical formulation 
     23   USE sbcflx           ! surface boundary condition: flux formulation 
     24   USE sbcblk_clio      ! surface boundary condition: bulk formulation : CLIO 
     25   USE sbcblk_core      ! surface boundary condition: bulk formulation : CORE 
     26   USE sbcice_if        ! surface boundary condition: ice-if sea-ice model 
     27   USE sbcice_lim       ! surface boundary condition: LIM 3.0 sea-ice model 
     28   USE sbcice_lim_2     ! surface boundary condition: LIM 2.0 sea-ice model 
     29   USE sbccpl           ! surface boundary condition: coupled florulation 
    3030   USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    31    USE sbcssr          ! surface boundary condition: sea surface restoring 
    32    USE sbcrnf          ! surface boundary condition: runoffs 
    33    USE sbcfwb          ! surface boundary condition: freshwater budget 
    34    USE closea          ! closed sea 
    35  
    36    USE prtctl          ! Print control                    (prt_ctl routine) 
    37    USE restart         ! ocean restart 
    38    USE iom 
    39    USE in_out_manager  ! I/O manager 
     31   USE sbcssr           ! surface boundary condition: sea surface restoring 
     32   USE sbcrnf           ! surface boundary condition: runoffs 
     33   USE sbcfwb           ! surface boundary condition: freshwater budget 
     34   USE closea           ! closed sea 
     35 
     36   USE prtctl           ! Print control                    (prt_ctl routine) 
     37   USE restart          ! ocean restart 
     38   USE iom              ! IOM library 
     39   USE in_out_manager   ! I/O manager 
    4040 
    4141   IMPLICIT NONE 
     
    5050#  include "domzgr_substitute.h90" 
    5151   !!---------------------------------------------------------------------- 
    52    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     52   !! NEMO/OPA 3.3 , NEMO-consortium (2010)  
    5353   !! $Id$ 
    5454   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5555   !!---------------------------------------------------------------------- 
    56  
    5756CONTAINS 
    5857 
     
    7069      INTEGER ::   icpt      ! temporary integer 
    7170      !! 
    72       NAMELIST/namsbc/ nn_fsbc, ln_ana, ln_flx, ln_blk_clio, ln_blk_core, ln_cpl,   & 
    73          &             nn_ice , ln_dm2dc, ln_rnf, ln_ssr, nn_fwb, nn_ico_cpl 
     71      NAMELIST/namsbc/ nn_fsbc, ln_ana  , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl    ,   & 
     72         &             nn_ice , ln_dm2dc, ln_rnf, ln_ssr     , nn_fwb     , nn_ico_cpl 
    7473      !!---------------------------------------------------------------------- 
    7574 
     
    8079      ENDIF 
    8180 
    82       REWIND( numnam )                   ! Read Namelist namsbc 
     81      REWIND( numnam )           ! Read Namelist namsbc 
    8382      READ  ( numnam, namsbc ) 
    8483 
    85       ! overwrite namelist parameter using CPP key information 
    86 !!gm here no overwrite, test all option via namelist change: require more incore memory 
    87 !!gm  IF( lk_sbc_cpl       ) THEN   ;   ln_cpl      = .TRUE.   ;   ELSE   ;   ln_cpl      = .FALSE.   ;   ENDIF 
    88  
    89       IF( Agrif_Root() ) THEN 
    90         IF( lk_lim2 )            nn_ice      = 2 
    91         IF( lk_lim3 )            nn_ice      = 3 
    92       ENDIF 
    93       ! 
    94       IF( cp_cfg == 'gyre' ) THEN 
     84      !                          ! overwrite namelist parameter using CPP key information 
     85      IF( Agrif_Root() ) THEN                ! AGRIF zoom 
     86        IF( lk_lim2 )   nn_ice      = 2 
     87        IF( lk_lim3 )   nn_ice      = 3 
     88      ENDIF 
     89      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration 
    9590          ln_ana      = .TRUE.    
    9691          nn_ice      =   0 
    9792      ENDIF 
    9893       
    99       ! Control print 
    100       IF(lwp) THEN 
     94      IF(lwp) THEN               ! Control print 
    10195         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
    10296         WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc 
     
    117111      ENDIF 
    118112 
     113      !                          ! Checks: 
    119114      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths  
    120115         ln_rnf_mouth  = .false.                       
     
    139134         &   CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' ) 
    140135       
    141       ! Choice of the Surface Boudary Condition (set nsbc) 
     136      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   & 
     137         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 
     138       
     139      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
     140         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
     141       
     142      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    142143      icpt = 0 
    143144      IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
     
    148149      IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation 
    149150      IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations 
    150  
     151      ! 
    151152      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
    152153         WRITE(numout,*) 
     
    229230 
    230231      !                                            !==  Misc. Options  ==! 
    231  
    232 !!gm  IF( ln_dm2dc       )   CALL sbc_dcy( kt )                 ! Daily mean qsr distributed over the Diurnal Cycle 
    233232       
    234233      SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over sea-ice areas 
     
    293292         CALL iom_put( "emp-rnf" , emp  - rnf )                   ! upward water flux 
    294293         CALL iom_put( "emps-rnf", emps - rnf )                   ! c/d water flux 
    295          CALL iom_put( "qns+qsr" , qns  + qsr )                   ! total heat flux   (caution if ln_dm2dc=true, to be  
    296          CALL iom_put( "qns"     , qns        )                   ! solar heat flux    moved after the call to iom_setkt) 
    297          CALL iom_put( "qsr"     ,       qsr  )                   ! solar heat flux    moved after the call to iom_setkt) 
     294         CALL iom_put( "qns+qsr" , qns  + qsr )                   ! total heat flux  
     295         CALL iom_put( "qns"     , qns        )                   ! solar heat flux 
     296         CALL iom_put( "qsr"     ,       qsr  )                   ! solar heat flux 
    298297         IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
    299298      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.