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 3625 for branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2012-11-21T14:19:18+01:00 (12 years ago)
Author:
acc
Message:

Branch dev_NOC_2012_r3555. #1006. Step 7. Check in code now merged with dev_r3385_NOCS04_HAMF

Location:
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC
Files:
45 edited

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90

    r3294 r3625  
    213213         !                                   ! Output trajectory fields 
    214214         CALL iom_rstput( it, it, inum, 'emp'   , emp    ) 
    215          CALL iom_rstput( it, it, inum, 'emps'  , emps   ) 
     215         CALL iom_rstput( it, it, inum, 'sfx'   , sfx    ) 
    216216         CALL iom_rstput( it, it, inum, 'un'    , un     ) 
    217217         CALL iom_rstput( it, it, inum, 'vn'    , vn     ) 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r3294 r3625  
    8383      z_frc_trd_s =           SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) )     ! salt fluxes 
    8484      ! Add penetrative solar radiation 
    85       IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qsr     (:,:) * surf(:,:) ) 
     85      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qsr     (:,:) * surf(:,:) ) 
    8686      ! Add geothermal heat flux 
    87       IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qgh_trd0(:,:) * surf(:,:) ) 
     87      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qgh_trd0(:,:) * surf(:,:) ) 
    8888      IF( lk_mpp ) THEN 
    8989         CALL mpp_sum( z_frc_trd_v ) 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r3609 r3625  
    400400         CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh 
    401401            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    402 !!$#if defined key_lim3 || defined key_lim2  
    403 !!$         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to 
    404 !!$         !    internal damping to Levitus that can be diagnosed from others 
    405 !!$         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup 
    406 !!$         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt 
    407 !!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    408 !!$         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass 
    409 !!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    410 !!$#endif 
    411402         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf) 
    412403            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    413 !!$         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs 
    414 !!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    415          CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! (emps-rnf) 
    416             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    417          CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! (emps-rnf) * sn 
    418             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     404         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! sfx 
     405            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     406#if ! defined key_vvl 
     407         CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"        &  ! emp * tsn(:,:,1,jp_tem) 
     408            &                                                                  , "KgC/m2/s",  &  ! sosst_cd 
     409            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     410         CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"           &  ! emp * tsn(:,:,1,jp_sal) 
     411            &                                                                  , "KgPSU/m2/s",&  ! sosss_cd 
     412            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     413#endif 
    419414         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr 
    420415            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    602597      CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal), ndim_hT, ndex_hT )   ! sea surface salinity 
    603598      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height 
    604 !!$#if  defined key_lim3 || defined key_lim2  
    605 !!$      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux 
    606 !!$      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux 
    607 !!$#endif 
    608599      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux 
    609 !!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff 
    610       CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux 
    611       zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    612       CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux 
     600      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux  
     601                                                                                  ! (includes virtual salt flux beneath ice  
     602                                                                                  ! in linear free surface case) 
     603#if ! defined key_vvl 
     604      zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 
     605      CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )             ! c/d term on sst 
     606      zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 
     607      CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )             ! c/d term on sss 
     608#endif 
    613609      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux 
    614610      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux 
    … …  
    782778      !!---------------------------------------------------------------------- 
    783779      !  
    784       IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') 
     780!     IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep 
    785781 
    786782      ! 0. Initialisation 
    … …  
    879875#endif 
    880876        
    881       IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') 
     877!     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 
    882878      !  
    883879 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r3294 r3625  
    5454    !!  level 14: qct(:,:)                 equivalent flux due to treshold SST 
    5555    !!  level 15: fbt(:,:)                 feedback term . 
    56     !!  level 16: ( emps(:,:) - rnf(:,:) ) concentration/dilution water flux 
     56    !!  level 16: ( emp * sss )            concentration/dilution term on salinity 
     57    !!  level 17: ( emp * sst )            concentration/dilution term on temperature 
    5758    !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater 
    5859    !!  level 18: gps(:,:)                 the surface pressure (m). 
    … …  
    107108 
    108109 
    109     inbsel = 17 
     110    inbsel = 18 
    110111 
    111112    IF( inbsel >  jpk ) THEN 
    … …  
    172173       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:) 
    173174       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:) 
    174        fsel(:,:,16) = fsel(:,:,16) + ( emps(:,:)-rnf(:,:) )  
     175       fsel(:,:,16) = fsel(:,:,16) + ( emp(:,:)*tsn(:,:,1,jp_sal) )  
     176       fsel(:,:,17) = fsel(:,:,17) + ( emp(:,:)*tsn(:,:,1,jp_tem) )  
    175177       ! 
    176178       ! Output of dynamics and tracer fields and selected fields 
    … …  
    240242          !         fsel(:,:,14) =  qct(:,:) 
    241243          !         fsel(:,:,15) =  fbt(:,:) 
    242           fsel(:,:,16) = ( emps(:,:)-rnf(:,:) ) * tmask(:,:,1)  
     244          fsel(:,:,16) = ( emp(:,:)-tsn(:,:,1,jp_sal) ) * tmask(:,:,1)  
     245          fsel(:,:,17) = ( emp(:,:)-tsn(:,:,1,jp_tem) ) * tmask(:,:,1)  
    243246          ! 
    244247          !         qct(:,:) = 0._wp 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r2715 r3625  
    1818   USE oce             ! dynamics and tracers 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE phycst 
    2021   USE in_out_manager  ! I/O manager 
    2122   USE sbc_oce         ! ocean surface boundary conditions 
    … …  
    173174      !!      put as run-off in open ocean. 
    174175      !! 
    175       !! ** Action  :   emp, emps   updated surface freshwater fluxes at kt 
     176      !! ** Action  :   emp   updated surface freshwater flux at kt 
    176177      !!---------------------------------------------------------------------- 
    177178      INTEGER, INTENT(in) ::   kt   ! ocean model time step 
    178179      ! 
    179180      INTEGER                     ::   ji, jj, jc, jn   ! dummy loop indices 
    180       REAL(wp)                    ::   zze2 
     181      REAL(wp)                    ::   zze2, zcoef, zcoef1 
    181182      REAL(wp), DIMENSION (jpncs) ::   zfwf  
    182183      !!---------------------------------------------------------------------- 
    … …  
    214215      ENDIF 
    215216      !                                                   !--------------------! 
    216       !                                                   !  update emp, emps  ! 
     217      !                                                   !  update emp        ! 
    217218      zfwf = 0.e0                                         !--------------------! 
    218219      DO jc = 1, jpncs 
    … …  
    235236         IF( ncstt(jc) == 0 ) THEN  
    236237            ! water/evap excess is shared by all open ocean 
    237             emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 
    238             emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 
     238            zcoef  = zfwf(jc) / surf(jpncs+1) 
     239            zcoef1 = rcp * zcoef 
     240            emp(:,:) = emp(:,:) + zcoef 
     241            qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
    239242         ELSEIF( ncstt(jc) == 1 ) THEN  
    240243            ! Excess water in open sea, at outflow location, excess evap shared 
    … …  
    245248                  IF (      ji > 1 .AND. ji < jpi   & 
    246249                      .AND. jj > 1 .AND. jj < jpj ) THEN  
    247                       emp (ji,jj) = emp (ji,jj) + zfwf(jc) /   & 
    248                          (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj)) 
    249                       emps(ji,jj) = emps(ji,jj) + zfwf(jc) /   & 
    250                           (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj)) 
     250                      zcoef  = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) ) 
     251                      zcoef1 = rcp * zcoef 
     252                      emp(ji,jj) = emp(ji,jj) + zcoef 
     253                      qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 
    251254                  END IF  
    252255                END DO  
    253256            ELSE  
    254                 emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 
    255                 emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 
     257                zcoef  = zfwf(jc) / surf(jpncs+1) 
     258                zcoef1 = rcp * zcoef 
     259                emp(:,:) = emp(:,:) + zcoef 
     260                qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
    256261            ENDIF 
    257262         ELSEIF( ncstt(jc) == 2 ) THEN  
    … …  
    262267                  ji = mi0(ncsir(jc,jn)) 
    263268                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 
    264                   emp (ji,jj) = emp (ji,jj) + zfwf(jc)   & 
    265                       / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) ) 
    266                   emps(ji,jj) = emps(ji,jj) + zfwf(jc)   & 
    267                       / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) ) 
     269                  zcoef  = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) ) 
     270                  zcoef1 = rcp * zcoef 
     271                  emp(ji,jj) = emp(ji,jj) + zcoef 
     272                  qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 
    268273                END DO  
    269274            ENDIF  
    … …  
    272277         DO jj = ncsj1(jc), ncsj2(jc) 
    273278            DO ji = ncsi1(jc), ncsi2(jc) 
    274                emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc) 
    275                emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc) 
     279               zcoef  = zfwf(jc) / surf(jc) 
     280               zcoef1 = rcp * zcoef 
     281               emp(ji,jj) = emp(ji,jj) - zcoef 
     282               qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj) 
    276283            END DO   
    277284         END DO  
    … …  
    280287      ! 
    281288      CALL lbc_lnk( emp , 'T', 1. ) 
    282       CALL lbc_lnk( emps, 'T', 1. ) 
    283289      ! 
    284290   END SUBROUTINE sbc_clo 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r3294 r3625  
    2727   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value 
    2828    
    29    REAL(wp), PUBLIC ::   rday = 24.*60.*60.       !: day (s) 
    30    REAL(wp), PUBLIC ::   rsiyea                   !: sideral year (s) 
    31    REAL(wp), PUBLIC ::   rsiday                   !: sideral day (s) 
    32    REAL(wp), PUBLIC ::   raamo =  12._wp          !: number of months in one year 
    33    REAL(wp), PUBLIC ::   rjjhh =  24._wp          !: number of hours in one day 
    34    REAL(wp), PUBLIC ::   rhhmm =  60._wp          !: number of minutes in one hour 
    35    REAL(wp), PUBLIC ::   rmmss =  60._wp          !: number of seconds in one minute 
    36 !! REAL(wp), PUBLIC ::   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit! 
    37    REAL(wp), PUBLIC ::   omega                    !: earth rotation parameter 
    38    REAL(wp), PUBLIC ::   ra    = 6371229._wp      !: earth radius (meter) 
    39    REAL(wp), PUBLIC ::   grav  = 9.80665_wp       !: gravity (m/s2) 
    40     
    41    REAL(wp), PUBLIC ::   rtt      = 273.16_wp     !: triple point of temperature (Kelvin) 
    42    REAL(wp), PUBLIC ::   rt0      = 273.15_wp     !: freezing point of water (Kelvin) 
     29   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s] 
     30   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s] 
     31   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s] 
     32   REAL(wp), PUBLIC ::   raamo =  12._wp        !: number of months in one year 
     33   REAL(wp), PUBLIC ::   rjjhh =  24._wp        !: number of hours in one day 
     34   REAL(wp), PUBLIC ::   rhhmm =  60._wp        !: number of minutes in one hour 
     35   REAL(wp), PUBLIC ::   rmmss =  60._wp        !: number of seconds in one minute 
     36   REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter           [s-1] 
     37   REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                       [m] 
     38   REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                            [m/s2] 
     39    
     40   REAL(wp), PUBLIC ::   rtt      = 273.16_wp        !: triple point of temperature   [Kelvin] 
     41   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin] 
    4342#if defined key_lim3 
    44    REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp     !: melting point of snow  (Kelvin) 
    45    REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp     !: melting point of ice   (Kelvin) 
    46 #else 
    47    REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp     !: melting point of snow  (Kelvin) 
    48    REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp     !: melting point of ice   (Kelvin) 
    49 #endif 
    50  
     43   REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp        !: melting point of snow         [Kelvin] 
     44   REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp        !: melting point of ice          [Kelvin] 
     45#else 
     46   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin] 
     47   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin] 
     48#endif 
    5149#if defined key_cice 
    52    REAL(wp), PUBLIC ::   rau0     = 1026._wp      !: reference volumic mass (density)  (kg/m3) 
    53 #else 
    54    REAL(wp), PUBLIC ::   rau0     = 1035._wp      !: reference volumic mass (density)  (kg/m3) 
    55 #endif 
    56    REAL(wp), PUBLIC ::   rau0r                    !: reference specific volume         (m3/kg) 
    57    REAL(wp), PUBLIC ::   rcp      =    4.e+3_wp   !: ocean specific heat 
    58    REAL(wp), PUBLIC ::   ro0cpr                   !: = 1. / ( rau0 * rcp ) 
     50   REAL(wp), PUBLIC ::   rau0     = 1026._wp         !: volumic mass of reference     [kg/m3] 
     51#else 
     52   REAL(wp), PUBLIC ::   rau0     = 1035._wp         !: volumic mass of reference     [kg/m3] 
     53#endif 
     54   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg] 
     55   REAL(wp), PUBLIC ::   rauw     = 1000._wp         !: volumic mass of pure water    [m3/kg] 
     56   REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/Kelvin] 
     57   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
     58   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
     59 
     60   REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3] 
     61   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice 
     62   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu] 
     63   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea               [psu] 
     64   REAL(wp), PUBLIC ::   cevap    =    2.5e+6_wp     !: latent heat of evaporation (water) 
     65   REAL(wp), PUBLIC ::   srgamma  =    0.9_wp        !: correction factor for solar radiation (Oberhuber, 1974) 
     66   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant 
     67   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant  
    5968 
    6069#if defined key_lim3 || defined key_cice 
    61    REAL(wp), PUBLIC ::   rcdsn   =   0.31_wp      !: thermal conductivity of snow 
    62    REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: thermal conductivity of fresh ice 
    63    REAL(wp), PUBLIC ::   cpic    = 2067.0         !: specific heat of sea ice 
    64    REAL(wp), PUBLIC ::   lsub    = 2.834e+6       !: pure ice latent heat of sublimation (J.kg-1) 
    65    REAL(wp), PUBLIC ::   lfus    = 0.334e+6       !: latent heat of fusion of fresh ice   (J.kg-1) 
    66    REAL(wp), PUBLIC ::   rhoic   = 917._wp        !: volumic mass of sea ice (kg/m3) 
    67    REAL(wp), PUBLIC ::   tmut    =   0.054        !: decrease of seawater meltpoint with salinity 
    68 #else 
    69    REAL(wp), PUBLIC ::   rcdsn   =   0.22_wp      !: conductivity of the snow 
    70    REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: conductivity of the ice 
    71    REAL(wp), PUBLIC ::   rcpsn   =   6.9069e+5_wp !: density times specific heat for snow 
    72    REAL(wp), PUBLIC ::   rcpic   =   1.8837e+6_wp !: volumetric latent heat fusion of sea ice 
    73    REAL(wp), PUBLIC ::   lfus    =   0.3337e+6    !: latent heat of fusion of fresh ice   (J.kg-1)     
    74    REAL(wp), PUBLIC ::   xlsn    = 110.121e+6_wp  !: volumetric latent heat fusion of snow 
    75    REAL(wp), PUBLIC ::   xlic    = 300.33e+6_wp   !: volumetric latent heat fusion of ice 
    76    REAL(wp), PUBLIC ::   xsn     =   2.8e+6       !: latent heat of sublimation of snow 
    77    REAL(wp), PUBLIC ::   rhoic   = 900._wp        !: volumic mass of sea ice (kg/m3) 
    78 #endif 
    79    REAL(wp), PUBLIC ::   rhosn   = 330._wp        !: volumic mass of snow (kg/m3) 
    80    REAL(wp), PUBLIC ::   emic    =   0.97_wp      !: emissivity of snow or ice 
    81    REAL(wp), PUBLIC ::   sice    =   6.0_wp       !: reference salinity of ice (psu) 
    82    REAL(wp), PUBLIC ::   soce    =  34.7_wp       !: reference salinity of sea (psu) 
    83    REAL(wp), PUBLIC ::   cevap   =   2.5e+6_wp    !: latent heat of evaporation (water) 
    84    REAL(wp), PUBLIC ::   srgamma =   0.9_wp       !: correction factor for solar radiation (Oberhuber, 1974) 
    85    REAL(wp), PUBLIC ::   vkarmn  =   0.4_wp       !: von Karman constant 
    86    REAL(wp), PUBLIC ::   stefan  =   5.67e-8_wp   !: Stefan-Boltzmann constant  
     70   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
     71   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
     72   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
     73   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     74   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
     75   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
     76   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
     77   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3] 
     78#else 
     79   REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3] 
     80   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K] 
     81   REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K] 
     82   REAL(wp), PUBLIC ::   cpic                        !: = rcpic / rhoic  (specific heat for ice)              [J/Kg/K] 
     83   REAL(wp), PUBLIC ::   rcdsn    =    0.22_wp       !: conductivity of the snow                              [W/m/K] 
     84   REAL(wp), PUBLIC ::   rcpsn    =    6.9069e+5_wp  !: volumetric specific heat for snow                     [J/m3/K] 
     85   REAL(wp), PUBLIC ::   xlsn     =  110.121e+6_wp   !: volumetric latent heat fusion of snow                 [J/m3] 
     86   REAL(wp), PUBLIC ::   lfus                        !: = xlsn / rhosn   (latent heat of fusion of fresh ice) [J/Kg] 
     87   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3] 
     88   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3] 
     89#endif 
    8790   !!---------------------------------------------------------------------- 
    8891   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    102105      !!---------------------------------------------------------------------- 
    103106 
    104       !                                   ! Define additional parameters 
    105       rsiyea = 365.25 * rday * 2. * rpi / 6.283076 
    106       rsiday = rday / ( 1. + rday / rsiyea ) 
    107 #if defined key_cice 
    108       omega =  7.292116e-05 
    109 #else 
    110       omega  = 2. * rpi / rsiday  
    111 #endif 
    112  
    113       rau0r  = 1. /   rau0   
    114       ro0cpr = 1. / ( rau0 * rcp ) 
    115  
    116  
    117       IF(lwp) THEN                        ! control print 
    118          WRITE(numout,*) 
    119          WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
    120          WRITE(numout,*) ' ~~~~~~~' 
     107      IF(lwp) WRITE(numout,*) 
     108      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
     109      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     110 
     111      ! Ocean Parameters 
     112      ! ---------------- 
     113      IF(lwp) THEN 
    121114         WRITE(numout,*) '       Domain info' 
    122115         WRITE(numout,*) '          dimension of model' 
    … …  
    131124         WRITE(numout,*) '             jpnij   : ', jpnij 
    132125         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio 
    133          WRITE(numout,*) 
    134          WRITE(numout,*) '       Constants' 
    135          WRITE(numout,*) 
    136          WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
    137          WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
    138          WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
    139          WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
    140          WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1' 
    141          WRITE(numout,*) 
    142          WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
    143          WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
    144          WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
    145          WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
    146          WRITE(numout,*) 
    147          WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
    148          WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
    149          WRITE(numout,*) 
    150          WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
    151          WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
    152          WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
    153          WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
    154          WRITE(numout,*) 
    155          WRITE(numout,*) '          ocean reference volumic mass       rau0   = ', rau0 , ' kg/m^3' 
    156          WRITE(numout,*) '          ocean reference specific volume    rau0r  = ', rau0r, ' m^3/Kg' 
    157          WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp 
    158          WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 
     126      ENDIF 
     127 
     128      ! Define constants 
     129      ! ---------------- 
     130      IF(lwp) WRITE(numout,*) 
     131      IF(lwp) WRITE(numout,*) '       Constants' 
     132 
     133      IF(lwp) WRITE(numout,*) 
     134      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
     135 
     136      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp 
     137      rsiday = rday / ( 1._wp + rday / rsiyea ) 
     138#if defined key_cice 
     139      omega  = 7.292116e-05 
     140#else 
     141      omega  = 2._wp * rpi / rsiday  
     142#endif 
     143      IF(lwp) WRITE(numout,*) 
     144      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
     145      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
     146      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
     147      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s^-1' 
     148 
     149      IF(lwp) WRITE(numout,*) 
     150      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
     151      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
     152      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
     153      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
     154 
     155      IF(lwp) WRITE(numout,*) 
     156      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
     157      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
     158 
     159      IF(lwp) WRITE(numout,*) 
     160      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
     161      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
     162      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
     163      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
     164 
     165      r1_rau0     = 1._wp / rau0 
     166      r1_rcp      = 1._wp / rcp 
     167      r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
     168      IF(lwp) WRITE(numout,*) 
     169      IF(lwp) WRITE(numout,*) '          volumic mass of pure water          rauw  = ', rauw   , ' kg/m^3' 
     170      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
     171      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
     172      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     173      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
     174 
     175 
     176#if defined key_lim3 || defined key_cice 
     177      xlsn = lfus * rhosn        ! volumetric latent heat fusion of snow [J/m3] 
     178#else 
     179      cpic = rcpic / rhoic       ! specific heat for ice   [J/Kg/K] 
     180      lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice 
     181#endif 
     182 
     183      IF(lwp) THEN 
    159184         WRITE(numout,*) 
    160185         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    161186         WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K' 
    162 #if defined key_lim3 
    163187         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    164188         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
     189#if defined key_lim3 || defined key_cice 
    165190         WRITE(numout,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg' 
    166 #elif defined key_cice 
    167          WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
    168191#else 
    169192         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K'  
    170193         WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K' 
    171194         WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m'  
    172          WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m'  
    173195         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg'  
    174196#endif 
     197         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3'  
    175198         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3' 
    176199         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3' 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r3322 r3625  
    8181      ! 
    8282      INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    83       REAL(wp) ::   z2dt, zg_2                             ! temporary scalar 
     83      REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r             ! temporary scalar 
    8484      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     85      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice 
    8586      !!---------------------------------------------------------------------- 
    8687      ! 
    … …  
    117118            END DO 
    118119         END DO 
     120      ENDIF 
     121 
     122      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 
     123         CALL wrk_alloc( jpi, jpj, zpice ) 
     124         !                                             
     125         zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
     126         zgrau0r     = - grav * r1_rau0 
     127         zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
     128         DO jj = 2, jpjm1 
     129            DO ji = fs_2, fs_jpim1   ! vector opt. 
     130               spgu(ji,jj) = ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 
     131               spgv(ji,jj) = ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 
     132            END DO 
     133         END DO 
     134         DO jk = 1, jpkm1                             ! Add the surface pressure trend to the general trend 
     135            DO jj = 2, jpjm1 
     136               DO ji = fs_2, fs_jpim1   ! vector opt. 
     137                  ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) 
     138                  va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) 
     139               END DO 
     140            END DO 
     141         END DO 
     142         ! 
     143         CALL wrk_dealloc( jpi, jpj, zpice ) 
    119144      ENDIF 
    120145 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r3294 r3625  
    6161      ! 
    6262      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    63       REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars 
     63      REAL(wp) ::   zlavmr, zua, zva   ! local scalars 
    6464      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy, zwz, zww 
    6565      !!---------------------------------------------------------------------- 
    … …  
    7575      ENDIF 
    7676 
    77       zrau0r = 1. / rau0               ! Local constant initialization 
    7877      zlavmr = 1. / REAL( nn_zdfexp ) 
    7978 
    … …  
    8180      DO jj = 2, jpjm1                 ! Surface boundary condition 
    8281         DO ji = 2, jpim1 
    83             zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * zrau0r 
    84             zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r 
     82            zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0 
     83            zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_rau0 
    8584         END DO   
    8685      END DO   

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r3294 r3625  
    161161         DO ji = fs_2, fs_jpim1   ! vector opt. 
    162162            ua(ji,jj,1) = ub(ji,jj,1) + p2dt * (  ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    163                &                                                       / ( fse3u(ji,jj,1) * rau0       )  ) 
     163               &                                                       * r1_rau0 / fse3u(ji,jj,1)       ) 
    164164         END DO 
    165165      END DO 
    … …  
    247247         DO ji = fs_2, fs_jpim1   ! vector opt. 
    248248            va(ji,jj,1) = vb(ji,jj,1) + p2dt * (  va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    249                &                                                       / ( fse3v(ji,jj,1) * rau0       )  ) 
     249               &                                                       * r1_rau0 / fse3v(ji,jj,1)       ) 
    250250         END DO 
    251251      END DO 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r3608 r3625  
    88   !!---------------------------------------------------------------------- 
    99   USE dom_oce          ! ocean space and time domain variables 
     10#if defined key_nemocice_decomp 
     11   USE ice_domain_size, only: nx_global, ny_global 
     12#endif 
    1013   USE in_out_manager   ! I/O manager 
    1114   USE lib_mpp          ! distributed memory computing 
    … …  
    431434      !  array (cf. par_oce.F90). 
    432435 
     436#if defined key_nemocice_decomp 
     437      ijpi = ( nx_global+2-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 
     438      ijpj = ( ny_global+2-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj  
     439#else 
    433440      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 
    434 #if defined key_nemocice_decomp 
    435       ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj  
    436 #else 
    437441      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
    438442#endif 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3609 r3625  
    120120 
    121121   ! variables used in case of sea-ice 
    122    INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice 
     122   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd) 
     123   INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology) 
    123124   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology) 
    124125   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors 
    … …  
    19781979      !!      ndim_rank_ice = number of processors with ice 
    19791980      !!      nrank_ice (ndim_rank_ice) = ice processors 
    1980       !!      ngrp_world = group ID for the world processors 
     1981      !!      ngrp_iworld = group ID for the world processors 
    19811982      !!      ngrp_ice = group ID for the ice processors 
    19821983      !!      ncomm_ice = communicator for the ice procs. 
    … …  
    20272028 
    20282029      ! Create the world group 
    2029       CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr ) 
     2030      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_iworld, ierr ) 
    20302031 
    20312032      ! Create the ice group from the world group 
    2032       CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr ) 
     2033      CALL MPI_GROUP_INCL( ngrp_iworld, ndim_rank_ice, nrank_ice, ngrp_ice, ierr ) 
    20332034 
    20342035      ! Create the ice communicator , ie the pool of procs with sea-ice 
    … …  
    20372038      ! Find proc number in the world of proc 0 in the north 
    20382039      ! The following line seems to be useless, we just comment & keep it as reminder 
    2039       ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr) 
    2040       ! 
     2040      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_iworld,n_ice_root,ierr) 
     2041      ! 
     2042      CALL MPI_GROUP_FREE(ngrp_ice, ierr) 
     2043      CALL MPI_GROUP_FREE(ngrp_iworld, ierr) 
     2044 
    20412045      DEALLOCATE(kice, zwork) 
    20422046      ! 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r3294 r3625  
    1616   !!   'key_ldfslp'                      Rotation of lateral mixing tensor 
    1717   !!---------------------------------------------------------------------- 
    18    !!   ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator) 
    19    !!   ldf_slp      : calculates the slopes of neutral surface   (Madec operator) 
    20    !!   ldf_slp_mxl  : calculates the slopes at the base of the mixed layer (Madec operator) 
    21    !!   ldf_slp_init : initialization of the slopes computation 
     18   !!   ldf_slp_grif  : calculates the triads of isoneutral slopes (Griffies operator) 
     19   !!   ldf_slp       : calculates the slopes of neutral surface   (Madec operator) 
     20   !!   ldf_slp_mxl   : calculates the slopes at the base of the mixed layer (Madec operator) 
     21   !!   ldf_slp_init  : initialization of the slopes computation 
    2222   !!---------------------------------------------------------------------- 
    23    USE oce             ! ocean dynamics and tracers 
    24    USE dom_oce         ! ocean space and time domain 
    25    USE ldftra_oce      ! lateral diffusion: traceur 
    26    USE ldfdyn_oce      ! lateral diffusion: dynamics 
    27    USE phycst          ! physical constants 
    28    USE zdfmxl          ! mixed layer depth 
    29    USE eosbn2          ! equation of states 
    30    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    31    USE in_out_manager  ! I/O manager 
    32    USE prtctl          ! Print control 
    33    USE wrk_nemo        ! work arrays 
    34    USE timing          ! Timing 
     23   USE oce            ! ocean dynamics and tracers 
     24   USE dom_oce        ! ocean space and time domain 
     25   USE ldftra_oce     ! lateral diffusion: traceur 
     26   USE ldfdyn_oce     ! lateral diffusion: dynamics 
     27   USE phycst         ! physical constants 
     28   USE zdfmxl         ! mixed layer depth 
     29   USE eosbn2         ! equation of states 
     30   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     31   USE in_out_manager ! I/O manager 
     32   USE prtctl         ! Print control 
     33   USE wrk_nemo       ! work arrays 
     34   USE timing         ! Timing 
     35   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3536 
    3637   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r3294 r3625  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   albedo_ice  : albedo for   ice (clear and overcast skies) 
    15    !!   albedo_oce  : albedo for ocean (clear and overcast skies) 
    16    !!   albedo_init : initialisation of albedo computation 
    17    !!---------------------------------------------------------------------- 
    18    USE phycst          ! physical constants 
    19    USE in_out_manager  ! I/O manager 
    20    USE lib_mpp         ! MPP library 
    21    USE wrk_nemo        ! work arrays 
     14   !!   albedo_ice    : albedo for   ice (clear and overcast skies) 
     15   !!   albedo_oce    : albedo for ocean (clear and overcast skies) 
     16   !!   albedo_init   : initialisation of albedo computation 
     17   !!---------------------------------------------------------------------- 
     18   USE phycst         ! physical constants 
     19   USE in_out_manager ! I/O manager 
     20   USE lib_mpp        ! MPP library 
     21   USE wrk_nemo       ! work arrays 
     22   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2223 
    2324   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r3294 r3625  
    9494   ! finally, arrays corresponding to different ice categories 
    9595   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i                !: category ice fraction 
    96    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt           !: category topmelt 
    97    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt           !: category botmelt 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
    9898#endif 
    9999 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r3609 r3625  
    4040   LOGICAL , PUBLIC ::   ln_apr_dyn  = .FALSE.   !: Atmospheric pressure forcing used on dynamics (ocean & ice) 
    4141   LOGICAL , PUBLIC ::   ln_icebergs = .FALSE.   !: Icebergs 
    42    INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2/3) 
     42   INTEGER , PUBLIC ::   nn_ice      = 0         !: flag for ice in the surface boundary condition (=0/1/2/3) 
     43   INTEGER , PUBLIC ::   nn_ice_embd = 0         !: flag for levitating/embedding sea-ice in the ocean 
     44   !                                             !: =0 levitating ice (no mass exchange, concentration/dilution effect) 
     45   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
     46   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    4347   INTEGER , PUBLIC ::   nn_fwb      = 0         !: FreshWater Budget:  
    4448   !                                             !:  = 0 unchecked  
    … …  
    6266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2] 
    6367   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s] 
    64    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s] 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx    , sfx_b    !: salt flux                                    [PSU/m2/s] 
    6569   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s] 
    6670   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]   
    … …  
    106110         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) )  
    107111         ! 
    108       ALLOCATE( qns_tot(jpi,jpj) , qns   (jpi,jpj) , qns_b(jpi,jpj),        & 
    109          &      qsr_tot(jpi,jpj) , qsr   (jpi,jpj) ,                        & 
    110          &      emp    (jpi,jpj) , emp_b (jpi,jpj) ,                        & 
    111          &      emps   (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) ) 
     112      ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        & 
     113         &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        & 
     114         &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        & 
     115         &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) ) 
    112116         ! 
    113117      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r3294 r3625  
    6060      !! 
    6161      !! ** Action  : - set the ocean surface boundary condition, i.e.   
    62       !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps 
     62      !!                   utau, vtau, taum, wndm, qns, qsr, emp 
    6363      !!---------------------------------------------------------------------- 
    6464      INTEGER, INTENT(in) ::   kt       ! ocean time step 
    … …  
    8989         nn_tau000 = MAX( nn_tau000, 1 )     ! must be >= 1 
    9090         ! 
    91          qns (:,:) = rn_qns0 
     91         emp (:,:) = rn_emp0 
     92         sfx (:,:) = 0.0_wp 
     93         qns (:,:) = rn_qns0 - emp(:,:) * sst_m(:,:) * rcp      ! including heat content associated with mass flux at SST 
    9294         qsr (:,:) = rn_qsr0 
    93          emp (:,:) = rn_emp0 
    94          emps(:,:) = rn_emp0 
    9595         ! 
    9696         utau(:,:) = rn_utau0 
    … …  
    130130      !! 
    131131      !! ** Action  : - set the ocean surface boundary condition, i.e.    
    132       !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps 
     132      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx 
    133133      !! 
    134134      !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000. 
    … …  
    211211         END DO 
    212212      END DO 
    213       emps(:,:) = emp(:,:) 
    214213 
    215214      ! Compute the emp flux such as its integration on the whole domain at each time is zero 
    … …  
    224223      ENDIF 
    225224 
    226       !salinity terms 
    227       emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1) 
    228       emps(:,:) = emp(:,:) 
     225      ! freshwater (mass flux) and update of qns with heat content of emp 
     226      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average) 
     227      sfx (:,:) = 0.0_wp                                   ! no salt flux 
     228      qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST 
    229229 
    230230 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r3294 r3625  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   sbc_blk_clio   : CLIO bulk formulation: read and update required input fields 
    15    !!   blk_clio_oce   : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean 
    16    !!   blk_ice_clio   : ice   CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice 
     14   !!   sbc_blk_clio     : CLIO bulk formulation: read and update required input fields 
     15   !!   blk_clio_oce     : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean 
     16   !!   blk_ice_clio     : ice   CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice 
    1717   !!   blk_clio_qsr_oce : shortwave radiation for ocean computed from the cloud cover 
    1818   !!   blk_clio_qsr_ice : shortwave radiation for ice   computed from the cloud cover 
    19    !!   flx_blk_declin : solar declinaison 
     19   !!   flx_blk_declin   : solar declination 
    2020   !!---------------------------------------------------------------------- 
    21    USE oce             ! ocean dynamics and tracers 
    22    USE dom_oce         ! ocean space and time domain 
    23    USE phycst          ! physical constants 
    24    USE fldread         ! read input fields 
    25    USE sbc_oce         ! Surface boundary condition: ocean fields 
    26    USE iom             ! I/O manager library 
    27    USE in_out_manager  ! I/O manager 
    28    USE lib_mpp         ! distribued memory computing library 
    29    USE wrk_nemo        ! work arrays 
    30    USE timing          ! Timing 
    31    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     21   USE oce            ! ocean dynamics and tracers 
     22   USE dom_oce        ! ocean space and time domain 
     23   USE phycst         ! physical constants 
     24   USE fldread        ! read input fields 
     25   USE sbc_oce        ! Surface boundary condition: ocean fields 
     26   USE iom            ! I/O manager library 
     27   USE in_out_manager ! I/O manager 
     28   USE lib_mpp        ! distribued memory computing library 
     29   USE wrk_nemo       ! work arrays 
     30   USE timing         ! Timing 
     31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     32   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3233 
    3334   USE albedo 
    … …  
    5051   INTEGER , PARAMETER ::   jp_vtau = 2           ! index of wind stress (j-component)      (N/m2)    at V-point 
    5152   INTEGER , PARAMETER ::   jp_wndm = 3           ! index of 10m wind module                 (m/s)    at T-point 
    52    INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( - ) 
    53    INTEGER , PARAMETER ::   jp_ccov = 5           ! index of cloud cover                     ( - ) 
     53   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % ) 
     54   INTEGER , PARAMETER ::   jp_ccov = 5           ! index of cloud cover                     ( % ) 
    5455   INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin) 
    5556   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
    … …  
    100101      !!      the i-component of the stress                (N/m2) 
    101102      !!      the j-component of the stress                (N/m2) 
    102       !!      the 10m wind pseed module                    (m/s) 
     103      !!      the 10m wind speed module                    (m/s) 
    103104      !!      the 10m air temperature                      (Kelvin) 
    104       !!      the 10m specific humidity                    (-) 
    105       !!      the cloud cover                              (-) 
     105      !!      the 10m specific humidity                    (%) 
     106      !!      the cloud cover                              (%) 
    106107      !!      the total precipitation (rain+snow)          (Kg/m2/s) 
    107108      !!              (2) CALL blk_oce_clio 
    108109      !! 
    109110      !!      C A U T I O N : never mask the surface stress fields 
    110       !!                      the stress is assumed to be in the mesh referential 
    111       !!                      i.e. the (i,j) referential 
     111      !!                      the stress is assumed to be in the (i,j) mesh referential 
    112112      !! 
    113113      !! ** Action  :   defined at each time-step at the air-sea interface 
    … …  
    115115      !!              - taum        wind stress module at T-point 
    116116      !!              - wndm        10m wind module at T-point 
    117       !!              - qns, qsr    non-slor and solar heat flux 
    118       !!              - emp, emps   evaporation minus precipitation 
     117      !!              - qns         non-solar heat flux including latent heat of solid  
     118      !!                            precip. melting and emp heat content 
     119      !!              - qsr         solar heat flux 
     120      !!              - emp         upward mass flux (evap. - precip) 
     121      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero 
     122      !!                            if ice is present (computed in limsbc(_2).F90) 
    119123      !!---------------------------------------------------------------------- 
    120       INTEGER, INTENT(in) ::   kt   ! ocean time step 
     124      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    121125      !! 
    122126      INTEGER  ::   ifpr, jfpr   ! dummy indices 
    … …  
    171175         ALLOCATE( sbudyko(jpi,jpj) , stauc(jpi,jpj), STAT=ierr3 ) 
    172176         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate arrays' ) 
     177         ! 
     178         sfx(:,:) = 0._wp                       ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 
    173179         ! 
    174180      ENDIF 
    … …  
    205211      !!               - taum        wind stress module at T-point 
    206212      !!               - wndm        10m wind module at T-point 
    207       !!               - qns, qsr    non-slor and solar heat flux 
    208       !!               - emp, emps   evaporation minus precipitation 
     213      !!               - qns         non-solar heat flux including latent heat of solid  
     214      !!                             precip. melting and emp heat content 
     215      !!               - qsr         solar heat flux 
     216      !!               - emp         suface mass flux (evap.-precip.) 
    209217      !!  ** Nota    :   sf has to be a dummy argument for AGRIF on NEC 
    210218      !!---------------------------------------------------------------------- 
    … …  
    223231      REAL(wp) ::   zsst, ztatm, zcco1, zpatm, zcmax, zrmax     !    -         - 
    224232      REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         - 
    225       REAL(wp) ::   ztx2, zty2                                  !    -         - 
     233      REAL(wp) ::   ztx2, zty2, zcevap, zcprec                  !    -         - 
    226234      REAL(wp), POINTER, DIMENSION(:,:) ::   zqlw        ! long-wave heat flux over ocean 
    227235      REAL(wp), POINTER, DIMENSION(:,:) ::   zqla        ! latent heat flux over ocean 
    … …  
    363371      !     III    Total FLUXES                                                       ! 
    364372      ! ----------------------------------------------------------------------------- ! 
    365  
    366 !CDIR COLLAPSE 
    367       emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 
    368       qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)         ! Downward Non Solar flux 
    369       emps(:,:) = emp(:,:) 
    370       ! 
     373      zcevap = rcp /  cevap    ! convert zqla ==> evap (Kg/m2/s) ==> m/s ==> W/m2 
     374      zcprec = rcp /  rday     ! convert prec ( mm/day ==> m/s)  ==> W/m2 
     375 
     376!CDIR COLLAPSE 
     377      emp(:,:) = zqla(:,:) / cevap                                        &   ! freshwater flux 
     378         &     - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 
     379      ! 
     380!CDIR COLLAPSE 
     381      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                        &   ! Downward Non Solar flux 
     382         &     - zqla(:,:)             * pst(:,:) * zcevap                &   ! remove evap.   heat content at SST in Celcius 
     383         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius 
     384      ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 
     385 
    371386      CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean 
    372387      CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean 
    … …  
    407422      !! 
    408423      !!  ** Action  :   call albedo_oce/albedo_ice to compute ocean/ice albedo  
    409       !!          computation of snow precipitation 
    410       !!          computation of solar flux at the ocean and ice surfaces 
    411       !!          computation of the long-wave radiation for the ocean and sea/ice 
    412       !!          computation of turbulent heat fluxes over water and ice 
    413       !!          computation of evaporation over water 
    414       !!          computation of total heat fluxes sensitivity over ice (dQ/dT) 
    415       !!          computation of latent heat flux sensitivity over ice (dQla/dT) 
    416       !! 
     424      !!               - snow precipitation 
     425      !!               - solar flux at the ocean and ice surfaces 
     426      !!               - the long-wave radiation for the ocean and sea/ice 
     427      !!               - turbulent heat fluxes over water and ice 
     428      !!               - evaporation over water 
     429      !!               - total heat fluxes sensitivity over ice (dQ/dT) 
     430      !!               - latent heat flux sensitivity over ice (dQla/dT) 
     431      !!               - qns  :  modified the non solar heat flux over the ocean 
     432      !!                         to take into account solid precip latent heat flux 
    417433      !!---------------------------------------------------------------------- 
    418434      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
    … …  
    594610      ! 
    595611      ! ----------------------------------------------------------------------------- ! 
    596       !    Total FLUXES                                                       ! 
     612      !    Total FLUXES                                                               ! 
    597613      ! ----------------------------------------------------------------------------- ! 
    598614      ! 
    … …  
    601617!CDIR COLLAPSE 
    602618      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
     619      ! 
     620      ! ----------------------------------------------------------------------------- ! 
     621      !    Correct the OCEAN non solar flux with the existence of solid precipitation ! 
     622      ! ---------------=====--------------------------------------------------------- ! 
     623!CDIR COLLAPSE 
     624      qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with: 
     625         &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip 
     626         &     + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting 
     627         &     - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair 
    603628      ! 
    604629!!gm : not necessary as all input data are lbc_lnk... 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3294 r3625  
    5252   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    5353   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    54    INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( - ) 
     54   INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( % ) 
    5555   INTEGER , PARAMETER ::   jp_qsr  = 4           ! index of solar heat                      (W/m2) 
    5656   INTEGER , PARAMETER ::   jp_qlw  = 5           ! index of Long wave                       (W/m2) 
    … …  
    6969   REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant 
    7070   REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice 
    71    REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be contant 
     71   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant 
    7272 
    7373   !                                  !!* Namelist namsbc_core : CORE bulk parameters 
    … …  
    9696      !!      the 10m wind velocity (i-component) (m/s)    at T-point 
    9797      !!      the 10m wind velocity (j-component) (m/s)    at T-point 
    98       !!      the specific humidity               ( - ) 
     98      !!      the 10m or 2m specific humidity     ( % ) 
    9999      !!      the solar heat                      (W/m2) 
    100100      !!      the Long wave                       (W/m2) 
    101       !!      the 10m air temperature             (Kelvin) 
     101      !!      the 10m or 2m air temperature       (Kelvin) 
    102102      !!      the total precipitation (rain+snow) (Kg/m2/s) 
    103103      !!      the snow (solid prcipitation)       (kg/m2/s) 
    104       !!   OPTIONAL parameter (see ln_taudif namelist flag): 
    105       !!      the tau diff associated to HF tau   (N/m2)   at T-point  
     104      !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T) 
    106105      !!              (2) CALL blk_oce_core 
    107106      !! 
    108107      !!      C A U T I O N : never mask the surface stress fields 
    109       !!                      the stress is assumed to be in the mesh referential 
    110       !!                      i.e. the (i,j) referential 
     108      !!                      the stress is assumed to be in the (i,j) mesh referential 
    111109      !! 
    112110      !! ** Action  :   defined at each time-step at the air-sea interface 
    113111      !!              - utau, vtau  i- and j-component of the wind stress 
    114       !!              - taum        wind stress module at T-point 
    115       !!              - wndm        10m wind module at T-point 
    116       !!              - qns, qsr    non-slor and solar heat flux 
    117       !!              - emp, emps   evaporation minus precipitation 
     112      !!              - taum, wndm  wind stress and 10m wind modules at T-point 
     113      !!              - qns, qsr    non-solar and solar heat fluxes 
     114      !!              - emp         upward mass flux (evapo. - precip.) 
     115      !!              - sfx         salt flux due to freezing/melting (non-zero only if ice is present) 
     116      !!                            (set in limsbc(_2).F90) 
    118117      !!---------------------------------------------------------------------- 
    119118      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    … …  
    125124      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files 
    126125      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read 
    127       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    128       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
    129       TYPE(FLD_N) ::   sn_tdif                                 !   "                                 " 
     126      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr             ! informations about the fields to be read 
     127      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif   !       -                       - 
    130128      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           & 
    131129         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    … …  
    181179         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' ) 
    182180         ! 
    183       ENDIF 
    184  
    185       CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step 
    186  
    187       !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
     181         sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 
     182         ! 
     183      ENDIF 
     184 
     185      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
     186 
     187      !                                            ! compute the surface ocean fluxes using CORE bulk formulea 
    188188      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 
    189189 
    … …  
    221221      !!              - qns     : Non Solar heat flux over the ocean    (W/m2) 
    222222      !!              - evap    : Evaporation over the ocean            (kg/m2/s) 
    223       !!              - emp(s)  : evaporation minus precipitation       (kg/m2/s) 
     223      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    224224      !! 
    225225      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
    … …  
    252252      zcoef_qsatw = 0.98 * 640380. / rhoa 
    253253       
    254       zst(:,:) = pst(:,:) + rt0      ! converte Celcius to Kelvin (and set minimum value far above 0 K) 
     254      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
    255255 
    256256      ! ----------------------------------------------------------------------------- ! 
    … …  
    378378      
    379379!CDIR COLLAPSE 
    380       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux 
    381 !CDIR COLLAPSE 
    382       emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 
    383 !CDIR COLLAPSE 
    384       emps(:,:) = emp(:,:) 
     380      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
     381         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
     382!CDIR COLLAPSE 
     383      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                       &   ! Downward Non Solar flux 
     384         &     - sf(jp_snow)%fnow(:,:,1) * lfus                          &   ! remove latent melting heat for solid precip 
     385         &     - zevap(:,:) * pst(:,:) * rcp                             &   ! remove evap heat content at SST 
     386         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) )   &   ! add liquid precip heat content at Tair 
     387         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                 &    
     388         &     + sf(jp_snow)%fnow(:,:,1)                                 &   ! add solid  precip heat content at min(Tair,Tsnow) 
     389         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic  
    385390      ! 
    386391      CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean 
    387392      CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean 
    388393      CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean 
     394      CALL iom_put( "qhc_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
    389395      CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean 
    390396      ! 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r3294 r3625  
    8484      !!              - wndm        10m wind module at T-point 
    8585      !!              - qns, qsr    non-slor and solar heat flux 
    86       !!              - emp, emps   evaporation minus precipitation 
     86      !!              - emp         evaporation minus precipitation 
    8787      !!---------------------------------------------------------------------- 
    8888      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  sh_now   ! specific humidity at T-point  
    … …  
    258258           emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1) 
    259259!CDIR COLLAPSE 
    260            emps(:,:) = emp(:,:) 
    261260 
    262261         CALL iom_put( "qlw_oce",   qbw  )                 ! output downward longwave heat over the ocean 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r3294 r3625  
    664664      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid  
    665665      !!                        taum, wndm   wind stres and wind speed module at T-point 
    666       !!                        qns , qsr    non solar and solar ocean heat fluxes   ('ocean only case) 
    667       !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case) 
     666      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case) 
     667      !!                                     and the latent heat flux of solid precip. melting 
     668      !!                        qsr          solar ocean heat fluxes   (ocean only case) 
     669      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 
    668670      !!---------------------------------------------------------------------- 
    669671      INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    … …  
    777779         ! Stress module can be negative when received (interpolation problem) 
    778780         IF( llnewtau ) THEN  
    779             frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) ) 
     781            frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) ) 
    780782         ENDIF 
    781783      ENDIF 
    … …  
    821823         !                                                   ! ========================= ! 
    822824         ! 
    823          !                                                       ! non solar heat flux over the ocean (qns) 
    824          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    825          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    826          ! add the latent heat of solid precip. melting 
    827          IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus               
    828  
    829          !                                                       ! solar flux over the ocean          (qsr) 
    830          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
    831          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    832          IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
    833          ! 
    834          !                                                       ! total freshwater fluxes over the ocean (emp, emps) 
     825         !                                                       ! total freshwater fluxes over the ocean (emp) 
    835826         SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    836827         CASE( 'conservative' ) 
    … …  
    863854!!gm  end of internal cooking 
    864855         ! 
    865          emps(:,:) = emp(:,:)                                        ! concentration/dilution = emp 
     856         !                                                       ! non solar heat flux over the ocean (qns) 
     857         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     858         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     859         ! add the latent heat of solid precip. melting 
     860         IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with: 
     861              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean 
     862           &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST) 
     863         ENDIF 
     864 
     865         !                                                       ! solar flux over the ocean          (qsr) 
     866         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     867         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
     868         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
     869         ! 
    866870   
    867871      ENDIF 
    … …  
    11411145 
    11421146      zicefr(:,:) = 1.- p_frld(:,:) 
    1143       IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 
     1147      zcptn(:,:) = rcp * sst_m(:,:) 
    11441148      ! 
    11451149      !                                                      ! ========================= ! 
    … …  
    12331237            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    12341238      END SELECT 
    1235       ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus               ! add the latent heat of solid precip. melting 
    1236       qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)                     ! over free ocean  
     1239      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 
     1240      qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with: 
     1241         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
     1242         &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST) 
     1243         &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
    12371244      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    12381245!!gm 
    … …  
    12541261      !                                                      ! ========================= ! 
    12551262      CASE( 'oce only' ) 
    1256          qsr_tot(:,:  ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 
     1263         qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
    12571264      CASE( 'conservative' ) 
    12581265         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    … …  
    13571364            ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    13581365         CASE( 'no' ) 
    1359             ztmp3(:,:,:) = 0.0 
     1366            ztmp3(:,:,:) = 0._wp 
    13601367            DO jl=1,jpl 
    13611368               ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    … …  
    14091416            ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
    14101417         CASE( 'no' ) 
    1411             ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0 
     1418            ztmp3(:,:,:) = 0._wp   ;  ztmp4(:,:,:) = 0._wp 
    14121419            DO jl=1,jpl 
    14131420               ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r2715 r3625  
    6161      !! 
    6262      !!      CAUTION :  - never mask the surface stress fields 
    63       !!                 - the stress is assumed to be in the mesh referential 
    64       !!                   i.e. the (i,j) referential 
     63      !!                 - the stress is assumed to be in the (i,j) mesh referential 
    6564      !! 
    6665      !! ** Action  :   update at each time-step 
    … …  
    6867      !!              - taum        wind stress module at T-point 
    6968      !!              - wndm        10m wind module at T-point 
    70       !!              - qns, qsr    non-slor and solar heat flux 
    71       !!              - emp, emps   evaporation minus precipitation 
     69      !!              - qns         non solar heat flux including heat flux due to emp 
     70      !!              - qsr         solar heat flux 
     71      !!              - emp         upward mass flux (evap. - precip.) 
     72      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero 
     73      !!                            if ice is present (computed in limsbc(_2).F90) 
    7274      !!---------------------------------------------------------------------- 
    7375      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    … …  
    121123         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 
    122124         ! 
     125         sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90) 
     126         ! 
    123127      ENDIF 
    124128 
    … …  
    139143            END DO 
    140144         END DO 
     145         !                                                        ! add to qns the heat due to e-p 
     146         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
     147         ! 
    141148         !                                                        ! module of wind stress and wind speed at T-point 
    142149         zcoef = 1. / ( zrhoa * zcdrag ) 
    … …  
    154161         CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
    155162 
    156          emps(:,:) = emp (:,:)                                    ! Initialization of emps (needed when no ice model) 
    157                    
    158163         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
    159164            WRITE(numout,*)  

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r3294 r3625  
    5959      !!                =3 global mean of emp set to zero at each nn_fsbc time step 
    6060      !!                   & spread out over erp area depending its sign 
     61      !! Note: if sea ice is embedded it is taken into account when computing the budget  
    6162      !!---------------------------------------------------------------------- 
    6263      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    … …  
    6465      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index 
    6566      ! 
    66       INTEGER  ::   inum, ikty, iyear   ! local integers 
    67       REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp   ! local scalars 
    68       REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread    !   -      - 
    69       REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor 
     67      INTEGER  ::   inum, ikty, iyear     ! local integers 
     68      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars 
     69      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      - 
     70      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces 
     71      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      - 
    7072      !!---------------------------------------------------------------------- 
    7173      ! 
    … …  
    8789         ! 
    8890         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
     91         ! 
     92#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice  
     93         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass 
     94         snwice_mass  (:,:) = 0.e0 
     95#endif 
     96         ! 
    8997      ENDIF 
    9098       
    … …  
    95103         ! 
    96104         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
    97             z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain 
    98             emp (:,:) = emp (:,:) - z_fwf  
    99             emps(:,:) = emps(:,:) - z_fwf  
     105            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain 
     106            zcoef = z_fwf * rcp 
     107            emp(:,:) = emp(:,:) - z_fwf  
     108            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
    100109         ENDIF 
    101110         ! 
    102111      CASE ( 2 )                             !==  fwf budget adjusted from the previous year  ==! 
    103112         ! 
    104          IF( kt == nit000 ) THEN                   ! initialisation 
     113         IF( kt == nit000 ) THEN                      ! initialisation 
    105114            !                                         ! Read the corrective factor on precipitations (fwfold) 
    106115            CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    … …  
    117126         ikty = 365 * 86400 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!! 
    118127         IF( MOD( kt, ikty ) == 0 ) THEN 
    119             a_fwb_b = a_fwb 
    120             a_fwb   = glob_sum( e1e2t(:,:) * sshn(:,:) )   ! sum over the global domain 
     128            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow 
     129                                                      ! sum over the global domain 
     130            a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 
    121131            a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s 
    122132!!gm        !                                                      !!bug 365d year  
    … …  
    125135         ENDIF 
    126136         !  
    127          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN      ! correct the freshwater fluxes 
    128             emp (:,:) = emp (:,:) + fwfold 
    129             emps(:,:) = emps(:,:) + fwfold 
    130          ENDIF 
    131          ! 
    132          IF( kt == nitend .AND. lwp ) THEN         ! save fwfold value in a file 
     137         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes 
     138            zcoef = fwfold * rcp 
     139            emp(:,:) = emp(:,:) + fwfold 
     140            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
     141         ENDIF 
     142         ! 
     143         IF( kt == nitend .AND. lwp ) THEN            ! save fwfold value in a file 
    133144            CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    134145            WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb 
    … …  
    143154            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 
    144155            ! 
    145             zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )   ! Area filled by <0 and >0 erp  
     156            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp  
    146157            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 
    147             !                                                  ! fwf global mean  
    148             z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area 
     158            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)  
     159            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area 
    149160            !             
    150161            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation 
    … …  
    160171            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall ) 
    161172            !                                                  ! weight to respect erp field 2D structure  
    162             zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
     173            zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
    163174            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
    164175            !                                                  ! final correction term to apply 
    … …  
    168179            CALL lbc_lnk( zerp_cor, 'T', 1. ) 
    169180            ! 
    170             emp (:,:) = emp (:,:) + zerp_cor(:,:) 
    171             emps(:,:) = emps(:,:) + zerp_cor(:,:) 
    172             erp (:,:) = erp (:,:) + zerp_cor(:,:) 
     181            emp(:,:) = emp(:,:) + zerp_cor(:,:) 
     182            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
     183            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
    173184            ! 
    174185            IF( nprint == 1 .AND. lwp ) THEN                   ! control print 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r3294 r3625  
    1515   USE dom_oce         ! ocean space and time domain 
    1616   USE domvvl 
    17    USE phycst, only : rcp, rau0 
     17   USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 
    1818   USE in_out_manager  ! I/O manager 
    1919   USE lib_mpp         ! distributed memory computing library 
    … …  
    3737   USE ice_gather_scatter 
    3838   USE ice_calendar, only: dt 
    39    USE ice_state, only: aice,aicen,uvel,vvel,vsnon,vicen 
     39   USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 
    4040   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
    4141                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     & 
    … …  
    5959   PUBLIC cice_sbc_final  ! routine called by sbc_final 
    6060   PUBLIC sbc_ice_cice    ! routine called by sbc 
     61 
     62   INTEGER , PARAMETER ::   ji_off = INT ( (jpiglo - nx_global) / 2 ) 
     63   INTEGER , PARAMETER ::   jj_off = INT ( (jpjglo - ny_global) / 2 ) 
    6164 
    6265   INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read  
    … …  
    107110      !! ** Action  : - time evolution of the CICE sea-ice model 
    108111      !!              - update all sbc variables below sea-ice: 
    109       !!                utau, vtau, qns , qsr, emp , emps 
     112      !!                utau, vtau, qns , qsr, emp , sfx 
    110113      !!--------------------------------------------------------------------- 
    111114      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    … …  
    143146      !! ** Purpose: Initialise ice related fields for NEMO and coupling 
    144147      !! 
    145       INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
    146       !!--------------------------------------------------------------------- 
    147  
    148       INTEGER  ::   ji, jj, jpl                        ! dummy loop indices 
     148      INTEGER, INTENT( in  ) ::   nsbc                ! surface forcing type 
     149      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
     150      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
     151      INTEGER  ::   ji, jj, jl                        ! dummy loop indices 
     152      !!--------------------------------------------------------------------- 
    149153 
    150154      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_init') 
     155      ! 
     156      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 
    151157      ! 
    152158      IF(lwp) WRITE(numout,*)'cice_sbc_init' 
    … …  
    182188      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    183189      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
    184          DO jpl=1,ncat 
    185             CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. ) 
     190         DO jl=1,ncat 
     191            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    186192         ENDDO 
    187193      ENDIF 
    … …  
    198204      CALL lbc_lnk ( fr_iu , 'U', 1. ) 
    199205      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
     206 
     207      !                                      ! embedded sea ice 
     208      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     209         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
     210         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     211         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     212         snwice_mass_b(:,:) = snwice_mass(:,:) 
     213      ELSE 
     214         snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
     215         snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     216      ENDIF 
     217      IF( nn_ice_embd == 2 .AND.          &  ! full embedment (case 2) & no restart :  
     218         &   .NOT.ln_rstart ) THEN           ! deplete the initial ssh belew sea-ice area 
     219         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
     220         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     221         ! 
     222         ! Note: Changed the initial values of sshb and sshn=>  need to recompute ssh[u,v,f]_[b,n]  
     223         !       which were previously set in domvvl 
     224         IF ( lk_vvl ) THEN            ! Is this necessary? embd 2 should be restricted to vvl only??? 
     225            DO jj = 1, jpjm1 
     226               DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible 
     227                  zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
     228                  zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
     229                  zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
     230                  sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
     231                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 
     232                  sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
     233                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 
     234                  sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
     235                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 
     236                  sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
     237                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 
     238               END DO 
     239            END DO 
     240            CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. ) 
     241            CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. ) 
     242            DO jj = 1, jpjm1 
     243               DO ji = 1, jpim1      ! NO Vector Opt. 
     244                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
     245                       &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     246                       &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     247                       &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     248               END DO 
     249            END DO 
     250            CALL lbc_lnk( sshf_n, 'F', 1. ) 
     251          ENDIF 
     252      ENDIF 
     253  
     254      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    200255      ! 
    201256      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init') 
    … …  
    212267      INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type 
    213268 
    214       INTEGER  ::   ji, jj, jpl                   ! dummy loop indices       
    215       REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
     269      INTEGER  ::   ji, jj, jl                   ! dummy loop indices       
     270      REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice 
    216271      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 
     272      REAL(wp) ::   zintb, zintn  ! dummy argument 
    217273      !!--------------------------------------------------------------------- 
    218274 
    219275      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_in') 
    220276      ! 
    221       CALL wrk_alloc( jpi,jpj, ztmp ) 
     277      CALL wrk_alloc( jpi,jpj, ztmp, zpice ) 
    222278      CALL wrk_alloc( jpi,jpj,ncat, ztmpn ) 
    223279 
    … …  
    259315! Surface downward latent heat flux (CI_5) 
    260316         IF (nsbc == 2) THEN 
    261             DO jpl=1,ncat 
    262                ztmpn(:,:,jpl)=qla_ice(:,:,1)*a_i(:,:,jpl) 
     317            DO jl=1,ncat 
     318               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    263319            ENDDO 
    264320         ELSE 
    … …  
    269325               DO ji=1,jpi 
    270326                  IF (fr_i(ji,jj).eq.0.0) THEN 
    271                      DO jpl=1,ncat 
    272                         ztmpn(ji,jj,jpl)=0.0 
     327                     DO jl=1,ncat 
     328                        ztmpn(ji,jj,jl)=0.0 
    273329                     ENDDO 
    274330                     ! This will then be conserved in CICE 
    275331                     ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 
    276332                  ELSE 
    277                      DO jpl=1,ncat 
    278                         ztmpn(ji,jj,jpl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj) 
     333                     DO jl=1,ncat 
     334                        ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 
    279335                     ENDDO 
    280336                  ENDIF 
    … …  
    282338            ENDDO 
    283339         ENDIF 
    284          DO jpl=1,ncat 
    285             CALL nemo2cice(ztmpn(:,:,jpl),flatn_f(:,:,jpl,:),'T', 1. ) 
     340         DO jl=1,ncat 
     341            CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 
    286342 
    287343! GBM conductive flux through ice (CI_6) 
    288344!  Convert to GBM 
    289345            IF (nsbc == 2) THEN 
    290                ztmp(:,:) = botmelt(:,:,jpl)*a_i(:,:,jpl) 
     346               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    291347            ELSE 
    292                ztmp(:,:) = botmelt(:,:,jpl) 
     348               ztmp(:,:) = botmelt(:,:,jl) 
    293349            ENDIF 
    294             CALL nemo2cice(ztmp,fcondtopn_f(:,:,jpl,:),'T', 1. ) 
     350            CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. ) 
    295351 
    296352! GBM surface heat flux (CI_7) 
    297353!  Convert to GBM 
    298354            IF (nsbc == 2) THEN 
    299                ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))*a_i(:,:,jpl)  
     355               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    300356            ELSE 
    301                ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl)) 
     357               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl)) 
    302358            ENDIF 
    303             CALL nemo2cice(ztmp,fsurfn_f(:,:,jpl,:),'T', 1. ) 
     359            CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. ) 
    304360         ENDDO 
    305361 
    … …  
    383439      CALL nemo2cice(ztmp,vocn,'F', -1. ) 
    384440 
     441      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
     442          ! 
     443          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     444          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
     445         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     446          ! 
     447          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
     448          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
     449         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     450          ! 
     451         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
     452          ! 
     453         ! 
     454      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
     455         zpice(:,:) = ssh_m(:,:) 
     456      ENDIF 
     457 
    385458! x comp and y comp of sea surface slope (on F points) 
    386459! T point to F point 
    387460      DO jj=1,jpjm1 
    388461         DO ji=1,jpim1 
    389             ztmp(ji,jj)=0.5 * (  (ssh_m(ji+1,jj  )-ssh_m(ji,jj  ))/e1u(ji,jj  )   & 
    390                                + (ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) &  
     462            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   & 
     463                               + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) &  
    391464                            *  fmask(ji,jj,1) 
    392465         ENDDO 
    … …  
    397470      DO jj=1,jpjm1 
    398471         DO ji=1,jpim1 
    399             ztmp(ji,jj)=0.5 * (  (ssh_m(ji  ,jj+1)-ssh_m(ji  ,jj))/e2v(ji  ,jj)   & 
    400                                + (ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) & 
     472            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   & 
     473                               + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 
    401474                            *  fmask(ji,jj,1) 
    402475         ENDDO 
    … …  
    420493      INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
    421494       
    422       INTEGER  ::   ji, jj, jpl                 ! dummy loop indices 
    423       REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
     495      INTEGER  ::   ji, jj, jl                 ! dummy loop indices 
     496      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
    424497      !!--------------------------------------------------------------------- 
    425498 
    426499      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_out') 
    427500      ! 
    428       CALL wrk_alloc( jpi,jpj, ztmp ) 
     501      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 
    429502       
    430503      IF( kt == nit000 )  THEN 
    … …  
    433506       
    434507! x comp of ocean-ice stress  
    435       CALL cice2nemo(strocnx,ztmp,'F', -1. ) 
     508      CALL cice2nemo(strocnx,ztmp1,'F', -1. ) 
    436509      ss_iou(:,:)=0.0 
    437510! F point to U point 
    438511      DO jj=2,jpjm1 
    439512         DO ji=2,jpim1 
    440             ss_iou(ji,jj) = 0.5 * ( ztmp(ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1) 
     513            ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 
    441514         ENDDO 
    442515      ENDDO 
    … …  
    444517 
    445518! y comp of ocean-ice stress  
    446       CALL cice2nemo(strocny,ztmp,'F', -1. ) 
     519      CALL cice2nemo(strocny,ztmp1,'F', -1. ) 
    447520      ss_iov(:,:)=0.0 
    448521! F point to V point 
    … …  
    450523      DO jj=1,jpjm1 
    451524         DO ji=2,jpim1 
    452             ss_iov(ji,jj) = 0.5 * ( ztmp(ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1) 
     525            ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 
    453526         ENDDO 
    454527      ENDDO 
    … …  
    473546         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    474547      ELSE IF (nsbc ==5) THEN 
    475 ! emp_tot is set in sbc_cpl_ice_flx (call from cice_sbc_in above)  
     548! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
     549! This is currently as required with the coupling fields from the UM atmosphere 
    476550         emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:)  
    477551      ENDIF 
    478552 
    479 ! Subtract fluxes from CICE to get freshwater equivalent flux used in  
    480 ! salinity calculation 
    481       CALL cice2nemo(fresh_gbm,ztmp,'T', 1. ) 
    482       emps(:,:)=emp(:,:)-ztmp(:,:) 
    483 ! Note the 1000.0 is to convert from kg salt to g salt (needed for PSU) 
    484       CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. ) 
    485       DO jj=1,jpj 
    486          DO ji=1,jpi 
    487             IF (sss_m(ji,jj).gt.0.0) THEN 
    488                emps(ji,jj)=emps(ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj) 
    489             ENDIF 
    490          ENDDO 
    491       ENDDO 
    492  
    493 ! No longer remove precip over ice from free surface calculation on basis that the 
    494 ! weight of the precip will affect the free surface even if it falls on the ice 
    495 ! (same to the argument that freezing / melting of ice doesn't change the free surface)  
    496 ! Sublimation from the ice is treated in a similar way (included in emp but not emps)   
    497 ! 
    498 ! This should not be done in the variable volume case 
    499  
    500       IF (.NOT. lk_vvl) THEN 
    501  
    502          emp(:,:)  = emp(:,:) - tprecip(:,:)*fr_i(:,:) 
    503  
    504 ! Take sublimation into account 
    505          IF (nsbc == 5 ) THEN  
    506             emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) ) 
    507          ELSE IF (nsbc == 2 ) THEN 
    508             emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub 
    509          ENDIF 
    510  
    511       ENDIF 
    512  
     553      CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 
     554      CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 
     555 
     556! Check to avoid unphysical expression when ice is forming (ztmp1 negative) 
     557! Otherwise we are effectively allowing ice of higher salinity than the ocean to form 
     558! which has to be compensated for by the ocean salinity potentially going negative 
     559! This check breaks conservation but seems reasonable until we have prognostic ice salinity 
     560! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU) 
     561      WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0) 
     562      sfx(:,:)=ztmp2(:,:)*1000.0 
     563      emp(:,:)=emp(:,:)-ztmp1(:,:) 
     564  
    513565      CALL lbc_lnk( emp , 'T', 1. ) 
    514       CALL lbc_lnk( emps , 'T', 1. ) 
     566      CALL lbc_lnk( sfx , 'T', 1. ) 
    515567 
    516568! Solar penetrative radiation and non solar surface heat flux 
    … …  
    532584! Now add in ice / snow related terms 
    533585! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 
    534       CALL cice2nemo(fswthru_gbm,ztmp,'T', 1. ) 
    535       qsr(:,:)=qsr(:,:)+ztmp(:,:) 
     586      CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 
     587      qsr(:,:)=qsr(:,:)+ztmp1(:,:) 
    536588      CALL lbc_lnk( qsr , 'T', 1. ) 
    537589 
    … …  
    542594      ENDDO 
    543595 
    544       CALL cice2nemo(fhocn_gbm,ztmp,'T', 1. ) 
    545       qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp(:,:) 
     596      CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 
     597      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 
    546598 
    547599      CALL lbc_lnk( qns , 'T', 1. ) 
    … …  
    551603      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    552604      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
    553          DO jpl=1,ncat 
    554             CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. ) 
     605         DO jl=1,ncat 
     606            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    555607         ENDDO 
    556608      ENDIF 
    … …  
    568620      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
    569621 
     622      !                                      ! embedded sea ice 
     623      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     624         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
     625         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     626         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     627         snwice_mass_b(:,:) = snwice_mass(:,:) 
     628         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 
     629      ENDIF 
     630 
    570631! Release work space 
    571632 
    572       CALL wrk_dealloc( jpi,jpj, ztmp ) 
     633      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    573634      ! 
    574635      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_out') 
    … …  
    587648      !!--------------------------------------------------------------------- 
    588649 
    589       INTEGER  ::   jpl                        ! dummy loop index 
     650      INTEGER  ::   jl                        ! dummy loop index 
    590651      INTEGER  ::   ierror 
    591652 
    … …  
    610671! Snow and ice thicknesses (CO_2 and CO_3) 
    611672 
    612       DO jpl = 1,ncat 
    613          CALL cice2nemo(vsnon(:,:,jpl,:),ht_s(:,:,jpl),'T', 1. ) 
    614          CALL cice2nemo(vicen(:,:,jpl,:),ht_i(:,:,jpl),'T', 1. ) 
     673      DO jl = 1,ncat 
     674         CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 
     675         CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 
    615676      ENDDO 
    616677      ! 
    … …  
    780841      REAL(wp), DIMENSION(jpi,jpj) :: pn 
    781842#if !defined key_nemocice_decomp 
     843      REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 
    782844      REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 
    783845#endif 
    … …  
    798860      ! Copy local domain data from NEMO to CICE field 
    799861      pc(:,:,1)=0.0 
    800       DO jj=2,ny_block 
    801          DO ji=2,nx_block 
    802             pc(ji,jj,1)=pn(ji,jj-1) 
     862      DO jj=2,ny_block-1 
     863         DO ji=2,nx_block-1 
     864            pc(ji,jj,1)=pn(ji-1+ji_off,jj-1+jj_off) 
    803865         ENDDO 
    804866      ENDDO 
    … …  
    824886!        pcg(:,:)=0.0 
    825887         DO jn=1,jpnij 
    826             DO jj=1,nlcjt(jn)-1 
    827                DO ji=2,nlcit(jn)-1 
    828                   pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn)        
     888            DO jj=nldjt(jn),nlejt(jn) 
     889               DO ji=nldit(jn),nleit(jn) 
     890                  png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 
    829891               ENDDO 
     892            ENDDO 
     893         ENDDO 
     894         DO jj=1,ny_global 
     895            DO ji=1,nx_global 
     896               pcg(ji,jj)=png2(ji+ji_off,jj+jj_off) 
    830897            ENDDO 
    831898         ENDDO 
    … …  
    922989      DO jj=1,jpjm1 
    923990         DO ji=1,jpim1 
    924             pn(ji,jj)=pc(ji,jj+1,1) 
     991            pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 
    925992         ENDDO 
    926993      ENDDO 
    … …  
    9361003! Need to make sure this is robust to changes in NEMO halo rows.... 
    9371004! (may be OK but not spent much time thinking about it) 
     1005! Note that non-existent pcg elements may be used below, but 
     1006! the lbclnk call on pn will replace these with sensible values 
    9381007 
    9391008      IF (nproc==0) THEN 
    9401009         png(:,:,:)=0.0 
    9411010         DO jn=1,jpnij 
    942             DO jj=1,nlcjt(jn)-1 
    943                DO ji=2,nlcit(jn)-1 
    944                   png(ji,jj,jn)=pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)       
     1011            DO jj=nldjt(jn),nlejt(jn) 
     1012               DO ji=nldit(jn),nleit(jn) 
     1013                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 
    9451014               ENDDO 
    9461015            ENDDO 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r3294 r3625  
    55   !!                   covered area using ice-if model 
    66   !!====================================================================== 
    7    !! History :  3.0   !  2006-06  (G. Madec)  Original code 
     7   !! History :  3.0  !  2006-06  (G. Madec)  Original code 
    88   !!---------------------------------------------------------------------- 
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   sbc_ice_if     : update sbc in ice-covered area 
     11   !!   sbc_ice_if    : update sbc in ice-covered area 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers 
    14    USE dom_oce         ! ocean space and time domain 
    15    USE phycst          ! physical constants 
    16    USE eosbn2          ! equation of state 
    17    USE sbc_oce         ! surface boundary condition: ocean fields 
     13   USE oce            ! ocean dynamics and tracers 
     14   USE dom_oce        ! ocean space and time domain 
     15   USE phycst         ! physical constants 
     16   USE eosbn2         ! equation of state 
     17   USE sbc_oce        ! surface boundary condition: ocean fields 
    1818   USE sbccpl 
    19    USE fldread         ! read input field 
    20    USE iom             ! I/O manager library 
    21    USE in_out_manager  ! I/O manager 
    22    USE lib_mpp         ! MPP library 
     19   USE fldread        ! read input field 
     20   USE iom            ! I/O manager library 
     21   USE in_out_manager ! I/O manager 
     22   USE lib_mpp        ! MPP library 
     23   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2324 
    2425   IMPLICIT NONE 
    … …  
    5152      !!                taum, wndm : remain unchanged 
    5253      !!                qns, qsr   : update heat flux below sea-ice 
    53       !!                emp, emps  : update freshwater flux below sea-ice 
     54      !!                emp, sfx   : update freshwater flux below sea-ice 
    5455      !!                fr_i       : update the ice fraction 
    5556      !!--------------------------------------------------------------------- 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r3294 r3625  
    1010   !!             -   ! 2008-04  (G. Madec)  sltyle and lim_ctl routine 
    1111   !!            3.3  ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step 
    12    !!            4.0  ! 2011-01  (A Porter)  dynamical allocation 
     12   !!            3.4  ! 2011-01  (A Porter)  dynamical allocation 
    1313   !!---------------------------------------------------------------------- 
    1414#if defined key_lim3 
    … …  
    8888      !! ** Action  : - time evolution of the LIM sea-ice model 
    8989      !!              - update all sbc variables below sea-ice: 
    90       !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
     90      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx  
    9191      !!--------------------------------------------------------------------- 
    9292      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    … …  
    170170 
    171171         !                                           ! intialisation to zero    !!gm is it truly necessary ??? 
    172          d_a_i_thd  (:,:,:)   = 0.e0   ;   d_a_i_trp  (:,:,:)   = 0.e0 
    173          d_v_i_thd  (:,:,:)   = 0.e0   ;   d_v_i_trp  (:,:,:)   = 0.e0 
    174          d_e_i_thd  (:,:,:,:) = 0.e0   ;   d_e_i_trp  (:,:,:,:) = 0.e0 
    175          d_v_s_thd  (:,:,:)   = 0.e0   ;   d_v_s_trp  (:,:,:)   = 0.e0 
    176          d_e_s_thd  (:,:,:,:) = 0.e0   ;   d_e_s_trp  (:,:,:,:) = 0.e0 
    177          d_smv_i_thd(:,:,:)   = 0.e0   ;   d_smv_i_trp(:,:,:)   = 0.e0 
    178          d_oa_i_thd (:,:,:)   = 0.e0   ;   d_oa_i_trp (:,:,:)   = 0.e0 
    179          ! 
    180          fseqv    (:,:) = 0.e0 
    181          fsbri    (:,:) = 0.e0     ;   fsalt_res(:,:) = 0.e0 
    182          fsalt_rpo(:,:) = 0.e0 
    183          fhmec    (:,:) = 0.e0     ;   fhbri    (:,:) = 0.e0 
    184          fmmec    (:,:) = 0.e0     ;   fheat_res(:,:) = 0.e0 
    185          fheat_rpo(:,:) = 0.e0     ;   focea2D  (:,:) = 0.e0 
    186          fsup2D   (:,:) = 0.e0 
     172         d_a_i_thd  (:,:,:)   = 0._wp   ;   d_a_i_trp  (:,:,:)   = 0._wp 
     173         d_v_i_thd  (:,:,:)   = 0._wp   ;   d_v_i_trp  (:,:,:)   = 0._wp 
     174         d_e_i_thd  (:,:,:,:) = 0._wp   ;   d_e_i_trp  (:,:,:,:) = 0._wp 
     175         d_v_s_thd  (:,:,:)   = 0._wp   ;   d_v_s_trp  (:,:,:)   = 0._wp 
     176         d_e_s_thd  (:,:,:,:) = 0._wp   ;   d_e_s_trp  (:,:,:,:) = 0._wp 
     177         d_smv_i_thd(:,:,:)   = 0._wp   ;   d_smv_i_trp(:,:,:)   = 0._wp 
     178         d_oa_i_thd (:,:,:)   = 0._wp   ;   d_oa_i_trp (:,:,:)   = 0._wp 
     179         ! 
     180         sfx    (:,:) = 0._wp 
     181         sfx_bri(:,:) = 0._wp   ;   sfx_mec  (:,:) = 0._wp   ;   sfx_res  (:,:) = 0._wp 
     182         fhbri  (:,:) = 0._wp   ;   fheat_mec(:,:) = 0._wp   ;   fheat_res(:,:) = 0._wp 
     183         fhmec  (:,:) = 0._wp   ;    
     184         fmmec  (:,:) = 0._wp      
     185         focea2D(:,:) = 0._wp 
     186         fsup2D (:,:) = 0._wp 
    187187         !  
    188          diag_sni_gr(:,:) = 0.e0   ;   diag_lat_gr(:,:) = 0.e0 
    189          diag_bot_gr(:,:) = 0.e0   ;   diag_dyn_gr(:,:) = 0.e0 
    190          diag_bot_me(:,:) = 0.e0   ;   diag_sur_me(:,:) = 0.e0 
     188         diag_sni_gr(:,:) = 0._wp   ;   diag_lat_gr(:,:) = 0._wp 
     189         diag_bot_gr(:,:) = 0._wp   ;   diag_dyn_gr(:,:) = 0._wp 
     190         diag_bot_me(:,:) = 0._wp   ;   diag_sur_me(:,:) = 0._wp 
    191191         ! dynamical invariants 
    192          delta_i(:,:) = 0.e0       ;   divu_i(:,:) = 0.e0       ;   shear_i(:,:) = 0.e0 
     192         delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp 
    193193 
    194194                          CALL lim_rst_opn( kt )     ! Open Ice restart file 
    … …  
    196196         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print 
    197197         ! 
    198          IF( .NOT. lk_c1d ) THEN 
    199                                                      ! Ice dynamics & transport (not in 1D case) 
     198         IF( .NOT. lk_c1d ) THEN                     ! Ice dynamics & transport (except in 1D case) 
    200199                          CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
    201200                          CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
    … …  
    210209                          CALL lim_var_bv                 ! bulk brine volume (diag) 
    211210                          CALL lim_thd( kt )              ! Ice thermodynamics  
    212                           zcoef = rdt_ice / 86400.e0      !  Ice natural aging 
     211                          zcoef = rdt_ice /rday           !  Ice natural aging 
    213212                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 
    214213                          CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin) 
    … …  
    268267 
    269268      inb_altests = 10 
    270       inb_alp(:)  = 0 
     269      inb_alp(:)  =  0 
    271270 
    272271      ! Alert if incompatible volume and concentration 
    … …  
    277276         DO jj = 1, jpj 
    278277            DO ji = 1, jpi 
    279                IF(  v_i(ji,jj,jl) /= 0.e0   .AND.   a_i(ji,jj,jl) == 0.e0   ) THEN 
     278               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN 
    280279                  WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    281280                  WRITE(numout,*) ' at_i     ', at_i(ji,jj) 
    … …  
    297296      DO jj = 1, jpj 
    298297         DO ji = 1, jpi 
    299             IF(   ht_i(ji,jj,jl) .GT. 50.0   ) THEN 
     298            IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN 
    300299               CALL lim_prt_state( ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
    301300               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    … …  
    309308      DO jj = 1, jpj 
    310309         DO ji = 1, jpi 
    311             IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) .GT. 0.5  .AND.  & 
    312                &  at_i(ji,jj) .GT. 0.e0   ) THEN 
     310            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 0.5  .AND.  & 
     311               &  at_i(ji,jj) > 0._wp   ) THEN 
    313312               CALL lim_prt_state( ji, jj, 1, ' ALERTE 4 :   Very fast ice ' ) 
    314313               WRITE(numout,*) ' ice strength             : ', strength(ji,jj) 
    … …  
    332331      DO jj = 1, jpj 
    333332         DO ji = 1, jpi 
    334             IF(   tms(ji,jj) .LE. 0.0   .AND.   at_i(ji,jj) .GT. 0.e0   ) THEN  
     333            IF(   tms(ji,jj) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN  
    335334               CALL lim_prt_state( ji, jj, 1, ' ALERTE 6 :   Ice on continents ' ) 
    336335               WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)  
    … …  
    356355            DO ji = 1, jpi 
    357356!!gm  test twice sm_i ...  ????  bug? 
    358                IF( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR. & 
    359                      ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. & 
    360                              ( a_i(ji,jj,jl) .GT. 0.e0 ) ) THEN 
     357               IF( ( ( ABS( sm_i(ji,jj,jl) ) < 0.5 )   .OR. & 
     358                     ( ABS( sm_i(ji,jj,jl) ) < 0.5 ) ) .AND. & 
     359                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
    361360!                 CALL lim_prt_state(ji,jj,1, ' ALERTE 7 :   Very fresh ice ' ) 
    362361!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    … …  
    377376         DO jj = 1, jpj 
    378377            DO ji = 1, jpi 
    379                IF ( ( ( ABS( o_i(ji,jj,jl) ) .GT. rdt_ice ) .OR. & 
    380                       ( ABS( o_i(ji,jj,jl) ) .LT. 0.00) ) .AND. & 
    381                              ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
     378               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 
     379                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 
     380                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
    382381                  CALL lim_prt_state( ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
    383382                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    … …  
    392391      DO jj = 1, jpj 
    393392         DO ji = 1, jpi 
    394             IF( ABS( emps(ji,jj) ) .GT. 1.0e-2 ) THEN 
     393            IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN 
    395394               CALL lim_prt_state( ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    396395               DO jl = 1, jpl 
    … …  
    412411      DO jj = 1, jpj 
    413412         DO ji = 1, jpi 
    414             IF(   ABS( qns(ji,jj) ) .GT. 1500.0   .AND.  ( at_i(ji,jj) .GT. 0.0 ) )  THEN 
     413            IF(   ABS( qns(ji,jj) ) > 1500._wp  .AND.  at_i(ji,jj) > 0._wp )  THEN 
    415414               ! 
    416415               WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
    … …  
    429428               WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)  
    430429               WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj)  
    431                WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(ji,jj)  
     430               WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)  
    432431               WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)  
    433432               WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj)  
    … …  
    450449               DO ji = 1, jpi 
    451450                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rtt 
    452                   IF( t_i(ji,jj,jk,jl) .GE. ztmelts  .AND.  v_i(ji,jj,jl) .GT. 1.e-6   & 
    453                      &                               .AND.  a_i(ji,jj,jl) .GT. 0.e0    ) THEN 
     451                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-6   & 
     452                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
    454453                     WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
    455454                     WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 
    … …  
    606605        WRITE(numout,*) ' - Heat / FW fluxes ' 
    607606        WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ ' 
    608 !       WRITE(numout,*) ' fsbri      : ', fsbri(ki,kj) 
    609 !       WRITE(numout,*) ' fseqv      : ', fseqv(ki,kj) 
     607!       WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ki,kj) 
     608!       WRITE(numout,*) ' sfx        : ', sfx      (ki,kj) 
    610609!       WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj) 
    611         WRITE(numout,*) ' fmmec      : ', fmmec(ki,kj) 
    612         WRITE(numout,*) ' fhmec      : ', fhmec(ki,kj) 
    613         WRITE(numout,*) ' fhbri      : ', fhbri(ki,kj) 
    614         WRITE(numout,*) ' fheat_rpo  : ', fheat_rpo(ki,kj) 
     610        WRITE(numout,*) ' fmmec      : ', fmmec    (ki,kj) 
     611        WRITE(numout,*) ' fhmec      : ', fhmec    (ki,kj) 
     612        WRITE(numout,*) ' fhbri      : ', fhbri    (ki,kj) 
     613        WRITE(numout,*) ' fheat_mec  : ', fheat_mec(ki,kj) 
    615614        WRITE(numout,*)  
    616615        WRITE(numout,*) ' sst        : ', sst_m(ki,kj)   
    … …  
    621620        WRITE(numout,*) ' utau_ice   : ', utau_ice(ki,kj)  
    622621        WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ki,kj) 
    623         WRITE(numout,*) ' utau       : ', utau(ki,kj)  
    624         WRITE(numout,*) ' vtau       : ', vtau(ki,kj) 
    625         WRITE(numout,*) ' oc. vel. u : ', u_oce(ki,kj) 
    626         WRITE(numout,*) ' oc. vel. v : ', v_oce(ki,kj) 
     622        WRITE(numout,*) ' utau       : ', utau    (ki,kj)  
     623        WRITE(numout,*) ' vtau       : ', vtau    (ki,kj) 
     624        WRITE(numout,*) ' oc. vel. u : ', u_oce   (ki,kj) 
     625        WRITE(numout,*) ' oc. vel. v : ', v_oce   (ki,kj) 
    627626     ENDIF 
    628627 
    … …  
    640639        WRITE(numout,*) 
    641640        WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    642         WRITE(numout,*) ' qsr        : ', qsr(ki,kj) 
    643         WRITE(numout,*) ' qns        : ', qns(ki,kj) 
     641        WRITE(numout,*) ' qsr       : ', qsr(ki,kj) 
     642        WRITE(numout,*) ' qns       : ', qns(ki,kj) 
    644643        WRITE(numout,*) 
    645644        WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 
    646         WRITE(numout,*) ' emps       : ', emps(ki,kj) 
    647         WRITE(numout,*) ' emp        : ', emp(ki,kj) 
    648         WRITE(numout,*) ' fsbri      : ', fsbri(ki,kj) 
    649         WRITE(numout,*) ' fseqv      : ', fseqv(ki,kj) 
    650         WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj) 
    651         WRITE(numout,*) ' fsalt_rpo  : ', fsalt_rpo(ki,kj) 
     645        WRITE(numout,*) ' emp       : ', emp    (ki,kj) 
     646        WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ki,kj) 
     647        WRITE(numout,*) ' sfx       : ', sfx    (ki,kj) 
     648        WRITE(numout,*) ' sfx_res   : ', sfx_res(ki,kj) 
     649        WRITE(numout,*) ' sfx_mec   : ', sfx_mec(ki,kj) 
    652650        WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    653         WRITE(numout,*) ' fheat_res  : ', fheat_res(ki,kj) 
     651        WRITE(numout,*) ' fheat_res : ', fheat_res(ki,kj) 
    654652        WRITE(numout,*) 
    655653        WRITE(numout,*) ' - Momentum fluxes ' 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r3294 r3625  
    8282      !! ** Action  : - time evolution of the LIM sea-ice model 
    8383      !!              - update all sbc variables below sea-ice: 
    84       !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
     84      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx  
    8585      !!--------------------------------------------------------------------- 
    8686      INTEGER, INTENT(in) ::   kt      ! ocean time step 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3609 r3625  
    1212   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing 
    1313   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
     14   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes 
    1415   !!---------------------------------------------------------------------- 
    1516 
    … …  
    8485      INTEGER ::   icpt   ! local integer 
    8586      !! 
    86       NAMELIST/namsbc/ nn_fsbc   , ln_ana , ln_flx  , ln_blk_clio, ln_blk_core, ln_cpl,   & 
    87          &             ln_blk_mfs, ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf, ln_ssr     , nn_fwb, ln_cdgw 
     87      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
     88         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
     89         &             ln_ssr    , nn_fwb    , ln_cdgw 
    8890      !!---------------------------------------------------------------------- 
    8991 
    … …  
    121123         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn 
    122124         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice  
     125         WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd = ', nn_ice_embd 
    123126         WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc  
    124127         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf 
    … …  
    136139         IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' ) 
    137140         nkrnf         = 0 
    138          rnf     (:,:) = 0.e0 
    139          rnfmsk  (:,:) = 0.e0 
    140          rnfmsk_z(:)   = 0.e0 
     141         rnf     (:,:) = 0.0_wp 
     142         rnfmsk  (:,:) = 0.0_wp 
     143         rnfmsk_z(:)   = 0.0_wp 
    141144      ENDIF 
    142145      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero 
     146 
     147      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
     148                                                   ! only if sea-ice is present 
    143149 
    144150      !                                            ! restartability    
    … …  
    157163      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
    158164         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
    159       IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) )   & 
    160          &   CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' ) 
     165      IF( nn_ice == 4 .AND. lk_agrif )   & 
     166         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
     167      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
     168         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 2 or 3' ) 
    161169       
    162170      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    … …  
    226234      !! ** Action  : - set the ocean surface boundary condition at before and now  
    227235      !!                time step, i.e.   
    228       !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, emps_b, qrp_b, erp_b 
    229       !!                utau  , vtau  , qns  , qsr  , emp  , emps  , qrp  , erp 
     236      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b 
     237      !!                utau  , vtau  , qns  , qsr  , emp  , sfx  , qrp  , erp 
    230238      !!              - updte the ice fraction : fr_i 
    231239      !!---------------------------------------------------------------------- 
    … …  
    243251         ! The 3D heat content due to qsr forcing is treated in traqsr 
    244252         ! qsr_b (:,:) = qsr (:,:) 
    245          emp_b (:,:) = emp (:,:) 
    246          emps_b(:,:) = emps(:,:) 
     253         emp_b(:,:) = emp(:,:) 
     254         sfx_b(:,:) = sfx(:,:) 
    247255      ENDIF 
    248256      !                                            ! ---------------------------------------- ! 
    … …  
    262270                                                             
    263271      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    264       !                                                  ! (i.e. utau,vtau, qns, qsr, emp, emps) 
     272      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    265273      CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
    266274      CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
    … …  
    314322            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b  )   ! before non solar heat flux (T-point) 
    315323            ! The 3D heat content due to qsr forcing is treated in traqsr 
    316             ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  )   ! before     solar heat flux (T-point) 
    317             CALL iom_get( numror, jpdom_autoglo, 'emp_b' , emp_b  )   ! before     freshwater flux (T-point) 
    318             CALL iom_get( numror, jpdom_autoglo, 'emps_b', emps_b )   ! before C/D freshwater flux (T-point) 
     324            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  ) ! before     solar heat flux (T-point) 
     325            CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b  )    ! before     freshwater flux (T-point) 
     326            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6 
     327            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 
     328               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point) 
     329            ELSE 
     330               sfx_b (:,:) = sfx(:,:) 
     331            ENDIF 
    319332         ELSE                                                   !* no restart: set from nit000 values 
    320333            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000' 
    … …  
    322335            vtau_b(:,:) = vtau(:,:) 
    323336            qns_b (:,:) = qns (:,:) 
    324             ! qsr_b (:,:) = qsr (:,:) 
    325             emp_b (:,:) = emp (:,:) 
    326             emps_b(:,:) = emps(:,:) 
     337            emp_b (:,:) = emp(:,:) 
     338            sfx_b (:,:) = sfx(:,:) 
    327339         ENDIF 
    328340      ENDIF 
    … …  
    340352         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    341353         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
    342          CALL iom_rstput( kt, nitrst, numrow, 'emps_b' , emps ) 
     354         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 
    343355      ENDIF 
    344356 
    … …  
    348360      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    349361         CALL iom_put( "empmr" , emp  - rnf )                   ! upward water flux 
    350          CALL iom_put( "empsmr", emps - rnf )                   ! c/d water flux 
     362         CALL iom_put( "saltflx", sfx  )                        ! downward salt flux   
     363                                                                ! (includes virtual salt flux beneath ice  
     364                                                                ! in linear free surface case) 
    351365         CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux  
    352366         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    … …  
    365379         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
    366380         CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
    367          CALL prt_ctl(tab2d_1=(emps-rnf)       , clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 
     381         CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf - : ', mask1=tmask, ovlap=1 ) 
    368382         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
    369383         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r3294 r3625  
    5656   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s] 
    5757    
    58    REAL(wp) ::   r1_rau0   ! = 1 / rau0  
    5958 
    6059   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) 
    … …  
    8382   END FUNCTION sbc_rnf_alloc 
    8483 
     84 
    8585   SUBROUTINE sbc_rnf( kt ) 
    8686      !!---------------------------------------------------------------------- 
    … …  
    9696      !!---------------------------------------------------------------------- 
    9797      INTEGER, INTENT(in) ::   kt          ! ocean time step 
    98       !! 
     98      ! 
    9999      INTEGER  ::   ji, jj   ! dummy loop indices 
    100100      !!---------------------------------------------------------------------- 
    … …  
    127127         ! 
    128128         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    129             rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )   
    130129            ! 
    131             r1_rau0 = 1._wp / rau0 
     130            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
     131            ! 
    132132            !                                                     ! set temperature & salinity content of runoffs 
    133133            IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
    … …  
    199199      !! 
    200200      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    201       REAL(wp) ::   r1_rau0   ! local scalar 
    202201      REAL(wp) ::   zfact     ! local scalar 
    203202      !!---------------------------------------------------------------------- 
    … …  
    205204      zfact = 0.5_wp 
    206205      ! 
    207       r1_rau0 = 1._wp / rau0 
    208206      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==! 
    209207         IF( lk_vvl ) THEN             ! variable volume case  
    … …  
    252250      INTEGER           ::   ji, jj, jk    ! dummy loop indices 
    253251      INTEGER           ::   ierror, inum  ! temporary integer 
    254       !!  
     252      ! 
    255253      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
    256254         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &   
    257255         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact   
    258256      !!---------------------------------------------------------------------- 
    259  
     257      ! 
    260258      !                                   ! ============ 
    261259      !                                   !   Namelist 
    … …  
    273271      REWIND ( numnam )                         ! Read Namelist namsbc_rnf 
    274272      READ   ( numnam, namsbc_rnf ) 
    275  
     273      ! 
    276274      !                                         ! Control print 
    277275      IF(lwp) THEN 
    … …  
    286284         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact     
    287285      ENDIF 
    288  
     286      ! 
    289287      !                                   ! ================== 
    290288      !                                   !   Type of runoff 
    … …  
    395393            nkrnf = 2 
    396394            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_0(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO 
    397             IF( ln_sco )   & 
    398                CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 
     395            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 
    399396         ENDIF 
    400397         IF(lwp) WRITE(numout,*) 
    … …  
    414411         nkrnf = 0 
    415412      ENDIF 
    416  
     413      ! 
    417414   END SUBROUTINE sbc_rnf_init 
    418415 
    … …  
    438435      !!                rnfmsk_z vertical structure 
    439436      !!---------------------------------------------------------------------- 
    440       ! 
    441437      INTEGER            ::   inum        ! temporary integers 
    442438      CHARACTER(len=140) ::   cl_rnfile   ! runoff file name 
    … …  
    446442      IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask' 
    447443      IF(lwp) WRITE(numout,*) '~~~~~~~~~ ' 
    448  
     444      ! 
    449445      cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname ) 
    450446      IF( .NOT. sn_cnf%ln_clim ) THEN   ;   WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear    ! add year 
    451447         IF( sn_cnf%cltype == 'monthly' )   WRITE(cl_rnfile, '(a,"m",i2)'  ) TRIM( cl_rnfile ), nmonth   ! add month 
    452448      ENDIF 
    453    
     449      ! 
    454450      ! horizontal mask (read in NetCDF file) 
    455451      CALL iom_open ( cl_rnfile, inum )                           ! open file 
    456452      CALL iom_get  ( inum, jpdom_data, sn_cnf%clvar, rnfmsk )    ! read the river mouth array 
    457453      CALL iom_close( inum )                                      ! close file 
    458        
     454      ! 
    459455      IF( nclosea == 1 )    CALL clo_rnf( rnfmsk )                ! closed sea inflow set as ruver mouth 
    460  
     456      ! 
    461457      rnfmsk_z(:)   = 0._wp                                        ! vertical structure  
    462458      rnfmsk_z(1)   = 1.0 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r3294 r3625  
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   sbc_ssr        : add to sbc a restoring term toward SST/SSS climatology 
    12    !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers 
    14    USE dom_oce         ! ocean space and time domain 
    15    USE sbc_oce         ! surface boundary condition 
    16    USE phycst          ! physical constants 
    17    USE sbcrnf          ! surface boundary condition : runoffs 
    18    USE fldread         ! read input fields 
    19    USE iom             ! I/O manager 
    20    USE in_out_manager  ! I/O manager 
    21    USE lib_mpp         ! distribued memory computing library 
    22    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    23    USE timing          ! Timing 
     11   !!   sbc_ssr       : add to sbc a restoring term toward SST/SSS climatology 
     12   !!---------------------------------------------------------------------- 
     13   USE oce            ! ocean dynamics and tracers 
     14   USE dom_oce        ! ocean space and time domain 
     15   USE sbc_oce        ! surface boundary condition 
     16   USE phycst         ! physical constants 
     17   USE sbcrnf         ! surface boundary condition : runoffs 
     18   USE fldread        ! read input fields 
     19   USE iom            ! I/O manager 
     20   USE in_out_manager ! I/O manager 
     21   USE lib_mpp        ! distribued memory computing library 
     22   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     23   USE timing         ! Timing 
     24   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2425 
    2526   IMPLICIT NONE 
    … …  
    6364      !!              - at each nscb time step 
    6465      !!                   add a retroaction term on qns    (nn_sstr = 1) 
    65       !!                   add a damping term on emps       (nn_sssr = 1) 
    66       !!                   add a damping term on emp & emps (nn_sssr = 2) 
     66      !!                   add a damping term on sfx        (nn_sssr = 1) 
     67      !!                   add a damping term on emp       (nn_sssr = 2) 
    6768      !!--------------------------------------------------------------------- 
    6869      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    … …  
    156157            !                                      ! ========================= ! 
    157158            ! 
    158             IF( nn_sstr == 1 ) THEN                   !* Temperature restoring term 
     159            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    159160!CDIR COLLAPSE 
    160161               DO jj = 1, jpj 
    … …  
    168169            ENDIF 
    169170            ! 
    170             IF( nn_sssr == 1 ) THEN                   !* Salinity damping term (salt flux, emps only) 
     171            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    171172               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    172173!CDIR COLLAPSE 
    … …  
    174175                  DO ji = 1, jpi 
    175176                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    176                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    177                         &        / ( sss_m(ji,jj) + 1.e-20   ) 
    178                      emps(ji,jj) = emps(ji,jj) + zerp 
    179                      erp( ji,jj) = zerp 
     177                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )  
     178                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux 
     179                     erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only) 
    180180                  END DO 
    181181               END DO 
    182182               CALL iom_put( "erp", erp )                             ! freshwater flux damping 
    183183               ! 
    184             ELSEIF( nn_sssr == 2 ) THEN               !* Salinity damping term (volume flux, emp and emps) 
     184            ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 
    185185               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    186186               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    … …  
    190190                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    191191                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    192                         &        / ( sss_m(ji,jj) + 1.e-20   ) 
     192                        &        / MAX(  sss_m(ji,jj), 1.e-20   ) 
    193193                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 
    194                      emp (ji,jj) = emp (ji,jj) + zerp 
    195                      emps(ji,jj) = emps(ji,jj) + zerp 
    196                      erp (ji,jj) = zerp 
     194                     emp(ji,jj) = emp (ji,jj) + zerp 
     195                     qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 
     196                     erp(ji,jj) = zerp 
    197197                  END DO 
    198198               END DO 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r3294 r3625  
    121121      REAL(wp) ::   zd , zc , zaw, za    !   -      - 
    122122      REAL(wp) ::   zb1, za1, zkw, zk0   !   -      - 
    123       REAL(wp) ::   zrau0r               !   -      - 
    124123      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    125124      !!---------------------------------------------------------------------- 
    … …  
    133132      ! 
    134133      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    135          zrau0r = 1.e0 / rau0 
    136134!CDIR NOVERRCHK 
    137135         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
    … …  
    174172                  ! masked in situ density anomaly 
    175173                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    176                      &             - rau0  ) * zrau0r * tmask(ji,jj,jk) 
     174                     &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk) 
    177175               END DO 
    178176            END DO 
    … …  
    254252      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    255253      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars 
    256       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      - 
     254      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0               !   -      - 
    257255      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    258256      !!---------------------------------------------------------------------- 
    … …  
    265263      ! 
    266264      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    267          zrau0r = 1.e0 / rau0 
    268265!CDIR NOVERRCHK 
    269266         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
    … …  
    309306                  ! masked in situ density anomaly 
    310307                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    311                      &             - rau0  ) * zrau0r * tmask(ji,jj,jk) 
     308                     &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk) 
    312309               END DO 
    313310            END DO 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r3294 r3625  
    1414   !!                   and vertical advection trends using MUSCL scheme 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and active tracers 
    17    USE dom_oce         ! ocean space and time domain 
    18    USE trdmod_oce      ! tracers trends  
    19    USE trdtra      ! tracers trends  
    20    USE in_out_manager  ! I/O manager 
    21    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    22    USE trabbl          ! tracers: bottom boundary layer 
    23    USE lib_mpp         ! distribued memory computing 
    24    USE lbclnk          ! ocean lateral boundary condition (or mpp link)  
    25    USE diaptr          ! poleward transport diagnostics 
    26    USE trc_oce         ! share passive tracers/Ocean variables 
    27    USE wrk_nemo        ! Memory Allocation 
    28    USE timing          ! Timing 
     16   USE oce            ! ocean dynamics and active tracers 
     17   USE dom_oce        ! ocean space and time domain 
     18   USE trdmod_oce     ! tracers trends  
     19   USE trdtra         ! tracers trends  
     20   USE in_out_manager ! I/O manager 
     21   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
     22   USE trabbl         ! tracers: bottom boundary layer 
     23   USE lib_mpp        ! distribued memory computing 
     24   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
     25   USE diaptr         ! poleward transport diagnostics 
     26   USE trc_oce        ! share passive tracers/Ocean variables 
     27   USE wrk_nemo       ! Memory Allocation 
     28   USE timing         ! Timing 
     29   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2930 
    3031   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r3294 r3625  
    2525   USE wrk_nemo        ! Memory Allocation 
    2626   USE timing          ! Timing 
    27  
     27   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2828 
    2929   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r3301 r3625  
    2828   USE wrk_nemo        ! Memory Allocation 
    2929   USE timing          ! Timing 
     30   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3031 
    3132   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r3294 r3625  
    1717 
    1818   !!---------------------------------------------------------------------- 
    19    !!   tra_adv_tvd  : update the tracer trend with the horizontal 
    20    !!                  and vertical advection trends using a TVD scheme 
    21    !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory 
    22    !!                  algorithm  
    23    !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean dynamics and active tracers 
    25    USE dom_oce         ! ocean space and time domain 
    26    USE trdmod_oce      ! tracers trends 
    27    USE trdtra          ! tracers trends 
    28    USE in_out_manager  ! I/O manager 
    29    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    30    USE lib_mpp         ! MPP library 
    31    USE lbclnk          ! ocean lateral boundary condition (or mpp link)  
    32    USE diaptr          ! poleward transport diagnostics 
    33    USE trc_oce         ! share passive tracers/Ocean variables 
    34    USE wrk_nemo        ! Memory Allocation 
    35    USE timing          ! Timing 
     19   !!   tra_adv_tvd   : update the tracer trend with the 3D advection trends using a TVD scheme 
     20   !!   nonosc        : compute monotonic tracer fluxes by a non-oscillatory algorithm  
     21   !!---------------------------------------------------------------------- 
     22   USE oce            ! ocean dynamics and active tracers 
     23   USE dom_oce        ! ocean space and time domain 
     24   USE trdmod_oce     ! tracers trends 
     25   USE trdtra         ! tracers trends 
     26   USE in_out_manager ! I/O manager 
     27   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
     28   USE lib_mpp        ! MPP library 
     29   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
     30   USE diaptr         ! poleward transport diagnostics 
     31   USE trc_oce        ! share passive tracers/Ocean variables 
     32   USE wrk_nemo       ! Memory Allocation 
     33   USE timing         ! Timing 
     34   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3635 
    3736   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r3294 r3625  
    1212   !!                 advection trends using a third order biaised scheme   
    1313   !!---------------------------------------------------------------------- 
    14    USE oce             ! ocean dynamics and active tracers 
    15    USE dom_oce         ! ocean space and time domain 
    16    USE trdmod_oce         ! ocean space and time domain 
     14   USE oce            ! ocean dynamics and active tracers 
     15   USE dom_oce        ! ocean space and time domain 
     16   USE trdmod_oce     ! ocean space and time domain 
    1717   USE trdtra 
    1818   USE lib_mpp 
    19    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    20    USE in_out_manager  ! I/O manager 
    21    USE diaptr          ! poleward transport diagnostics 
    22    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    23    USE trc_oce         ! share passive tracers/Ocean variables 
    24    USE wrk_nemo        ! Memory Allocation 
    25    USE timing          ! Timing 
     19   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     20   USE in_out_manager ! I/O manager 
     21   USE diaptr         ! poleward transport diagnostics 
     22   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
     23   USE trc_oce        ! share passive tracers/Ocean variables 
     24   USE wrk_nemo       ! Memory Allocation 
     25   USE timing         ! Timing 
     26   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2627 
    2728   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r3294 r3625  
    155155         CASE ( 1 )                          !* constant flux 
    156156            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst 
    157             qgh_trd0(:,:) = ro0cpr * rn_geoflx_cst 
     157            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 
    158158            ! 
    159159         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 
    … …  
    162162            CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 
    163163            CALL iom_close( inum ) 
    164             qgh_trd0(:,:) = ro0cpr * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2 
     164            qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2 
    165165            ! 
    166166         CASE DEFAULT 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r3294 r3625  
    147147         !                                        ! ============================================== ! 
    148148         DO jk = 1, jpkm1 
    149             qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
     149            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
    150150         END DO 
    151151         !                                        Add to the general trend 
    … …  
    219219               ! 
    220220               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
    221                   qsr_hc(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
     221                  qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
    222222               END DO 
    223223               zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero 
    … …  
    236236            ! 
    237237            IF( lk_vvl ) THEN                                  !* variable volume 
    238                zz0   =        rn_abs   * ro0cpr 
    239                zz1   = ( 1. - rn_abs ) * ro0cpr 
     238               zz0   =        rn_abs   * r1_rau0_rcp 
     239               zz1   = ( 1. - rn_abs ) * r1_rau0_rcp 
    240240               DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m  
    241241                  DO jj = 1, jpj 
    … …  
    463463                  ! 
    464464                  DO jk = 1, nksr 
    465                      etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )  
     465                     etot3(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) )  
    466466                  END DO 
    467467                  etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero 
    … …  
    484484               IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step' 
    485485            ELSE                                ! constant volume: computes one for all 
    486                zz0 =        rn_abs   * ro0cpr 
    487                zz1 = ( 1. - rn_abs ) * ro0cpr 
     486               zz0 =        rn_abs   * r1_rau0_rcp 
     487               zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 
    488488               DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all 
    489489                  DO jj = 1, jpj                              ! top 400 meters 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r3294 r3625  
    6060      !!         at the surface by evaporation, precipitations and runoff (E-P-R);  
    6161      !!      (3) Fwe, tracer carried with the water that is exchanged.  
     62      !!            - salinity    : salt flux only due to freezing/melting 
     63      !!            sa = sa +  sfx / rau0 / e3t  for k=1 
    6264      !! 
    6365      !!      Fext, flux through the air-sea interface for temperature and salt:  
    … …  
    8486      !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST 
    8587      !!            - salinity    : evaporation, precipitation and runoff 
    86       !!         water has a zero salinity (Fwe=0), thus only Fwi remains: 
    87       !!            sa = sa + emp * sn / e3t   for k=1 
     88      !!         water has a zero salinity  but there is a salt flux due to  
     89      !!         freezing/melting, thus: 
     90      !!            sa = sa + emp * sn / rau0 / e3t   for k=1 
     91      !!                    + sfx    / rau0 / e3t 
    8892      !!         where emp, the surface freshwater budget (evaporation minus 
    8993      !!         precipitation minus runoff) given in kg/m2/s is divided 
    90       !!         by 1035 kg/m3 (density of ocena water) to obtain m/s.     
     94      !!         by rau0 = 1020 kg/m3 (density of sea water) to obtain m/s.     
    9195      !!         Note: even though Fwe does not appear explicitly for  
    9296      !!         temperature in this routine, the heat carried by the water 
    … …  
    109113      !! 
    110114      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices   
    111       REAL(wp) ::   zfact, z1_e3t, zsrau, zdep 
     115      REAL(wp) ::   zfact, z1_e3t, zdep 
    112116      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    113117      !!---------------------------------------------------------------------- 
    … …  
    120124         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    121125      ENDIF 
    122  
    123       zsrau = 1. / rau0             ! initialization 
    124126 
    125127      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    … …  
    163165                                                   ! evaporation, precipitation and qns, but not river runoff  
    164166                                                
    165       IF( lk_vvl ) THEN                            ! Variable Volume case 
     167      IF( lk_vvl ) THEN                            ! Variable Volume case  ==>> heat content of mass flux is in qns 
    166168         DO jj = 1, jpj 
    167169            DO ji = 1, jpi  
    168                ! temperature : heat flux + cooling/heating effet of EMP flux 
    169                sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem) 
    170                ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration 
    171                sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal) 
     170               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                              ! non solar heat flux 
     171               sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)                              ! salt flux due to freezing/melting 
    172172            END DO 
    173173         END DO 
    174       ELSE                                         ! Constant Volume case 
     174      ELSE                                         ! Constant Volume case ==>> Concentration dilution effect 
    175175         DO jj = 2, jpj 
    176176            DO ji = fs_2, fs_jpim1   ! vector opt. 
    177177               ! temperature : heat flux 
    178                sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) 
    179                ! salinity    : salt flux + concent./dilut. effect (both in emps) 
    180                sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal) 
     178               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                          &   ! non solar heat flux 
     179                  &                  + r1_rau0     * emp(ji,jj)  * tsn(ji,jj,1,jp_tem)       ! concent./dilut. effect 
     180               ! salinity    : salt flux + concent./dilut. effect (both in sfx) 
     181               sbc_tsc(ji,jj,jp_sal) = r1_rau0  * (  sfx(ji,jj)                          &   ! salt flux (freezing/melting) 
     182                  &                                + emp(ji,jj) * tsn(ji,jj,1,jp_sal) )      ! concent./dilut. effect 
    181183            END DO 
    182184         END DO 
     185         CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )                          ! c/d term on sst 
     186         CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )                          ! c/d term on sss 
    183187      ENDIF 
    184188      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff   

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r3294 r3625  
    1212   !!   'key_zdfgls'                 Generic Length Scale vertical physics 
    1313   !!---------------------------------------------------------------------- 
    14    !!   zdf_gls      : update momentum and tracer Kz from a gls scheme 
    15    !!   zdf_gls_init : initialization, namelist read, and parameters control 
    16    !!   gls_rst      : read/write gls restart in ocean restart file 
     14   !!   zdf_gls       : update momentum and tracer Kz from a gls scheme 
     15   !!   zdf_gls_init  : initialization, namelist read, and parameters control 
     16   !!   gls_rst       : read/write gls restart in ocean restart file 
    1717   !!---------------------------------------------------------------------- 
    1818   USE oce            ! ocean dynamics and active tracers  
    … …  
    3131   USE iom            ! I/O manager library 
    3232   USE timing         ! Timing 
     33   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3334 
    3435   IMPLICIT NONE 
    … …  
    167168            !  
    168169            ! surface friction  
    169             ustars2(ji,jj) = rau0r * taum(ji,jj) * tmask(ji,jj,1) 
     170            ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 
    170171            ! 
    171172            ! bottom friction (explicit before friction) 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r3294 r3625  
    1515   !!   'key_zdfkpp'                                             KPP scheme 
    1616   !!---------------------------------------------------------------------- 
    17    !!   zdf_kpp      : update momentum and tracer Kz from a kpp scheme 
    18    !!   zdf_kpp_init : initialization, namelist read, and parameters control 
    19    !!   tra_kpp      : compute and add to the T & S trend the non-local flux 
    20    !!   trc_kpp      : compute and add to the passive tracer trend the non-local flux (lk_top=T) 
     17   !!   zdf_kpp       : update momentum and tracer Kz from a kpp scheme 
     18   !!   zdf_kpp_init  : initialization, namelist read, and parameters control 
     19   !!   tra_kpp       : compute and add to the T & S trend the non-local flux 
     20   !!   trc_kpp       : compute and add to the passive tracer trend the non-local flux (lk_top=T) 
    2121   !!---------------------------------------------------------------------- 
    22    USE oce             ! ocean dynamics and active tracers  
    23    USE dom_oce         ! ocean space and time domain 
    24    USE zdf_oce         ! ocean vertical physics 
    25    USE sbc_oce         ! surface boundary condition: ocean 
    26    USE phycst          ! physical constants 
    27    USE eosbn2          ! equation of state 
    28    USE zdfddm          ! double diffusion mixing 
    29    USE in_out_manager  ! I/O manager 
    30    USE lib_mpp         ! MPP library 
    31    USE wrk_nemo        ! work arrays 
    32    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    33    USE prtctl          ! Print control 
    34    USE trdmod_oce      ! ocean trends definition 
    35    USE trdtra          ! tracers trends 
    36    USE timing          ! Timing 
     22   USE oce            ! ocean dynamics and active tracers  
     23   USE dom_oce        ! ocean space and time domain 
     24   USE zdf_oce        ! ocean vertical physics 
     25   USE sbc_oce        ! surface boundary condition: ocean 
     26   USE phycst         ! physical constants 
     27   USE eosbn2         ! equation of state 
     28   USE zdfddm         ! double diffusion mixing 
     29   USE in_out_manager ! I/O manager 
     30   USE lib_mpp        ! MPP library 
     31   USE wrk_nemo       ! work arrays 
     32   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     33   USE prtctl         ! Print control 
     34   USE trdmod_oce     ! ocean trends definition 
     35   USE trdtra         ! tracers trends 
     36   USE timing         ! Timing 
     37   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3738 
    3839   IMPLICIT NONE 
    … …  
    426427            zBosol(ji,jj) = grav * zthermal * qsr(ji,jj) 
    427428            ! Non radiative surface buoyancy force 
    428             zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emps(ji,jj)-rnf(ji,jj) )  
     429            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emp(ji,jj)-rnf(ji,jj) )  & 
     430               &                                         -  grav * rbeta * rcs * sfx(ji,jj) 
    429431            ! Surface Temperature flux for non-local term 
    430             wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1) 
     432            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r1_rau0_rcp * tmask(ji,jj,1) 
    431433            ! Surface salinity flux for non-local term 
    432             ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) * rcs ) * tmask(ji,jj,1)  
     434            ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)                          & 
     435               &             + sfx(ji,jj)                                     ) * rcs * tmask(ji,jj,1)  
    433436         ENDDO 
    434437      ENDDO 
    … …  
    13241327               DO ji = fs_2, fs_jpim1 
    13251328                  ! Surface tracer flux for non-local term  
    1326                   zflx = - ( emps(ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1) 
     1329                  zflx = - ( sfx (ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1) 
    13271330                  ! compute the trend 
    13281331                  ztra = - ( ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   & 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r3294 r3625  
    1717   !!   'key_zdfric'                                             Kz = f(Ri) 
    1818   !!---------------------------------------------------------------------- 
    19    !!   zdf_ric      : update momentum and tracer Kz from the Richardson 
     19   !!   zdf_ric       : update momentum and tracer Kz from the Richardson 
    2020   !!                  number computation 
    21    !!   zdf_ric_init : initialization, namelist read, & parameters control 
    22    !!---------------------------------------------------------------------- 
    23    USE oce                   ! ocean dynamics and tracers variables 
    24    USE dom_oce               ! ocean space and time domain variables 
    25    USE zdf_oce               ! ocean vertical physics 
    26    USE in_out_manager        ! I/O manager 
    27    USE lbclnk                ! ocean lateral boundary condition (or mpp link) 
    28    USE lib_mpp               ! MPP library 
    29    USE wrk_nemo              ! work arrays 
    30    USE timing                ! Timing 
     21   !!   zdf_ric_init  : initialization, namelist read, & parameters control 
     22   !!---------------------------------------------------------------------- 
     23   USE oce            ! ocean dynamics and tracers variables 
     24   USE dom_oce        ! ocean space and time domain variables 
     25   USE zdf_oce        ! ocean vertical physics 
     26   USE in_out_manager ! I/O manager 
     27   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     28   USE lib_mpp        ! MPP library 
     29   USE wrk_nemo       ! work arrays 
     30   USE timing         ! Timing 
     31   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3132 
    3233   USE eosbn2, ONLY : nn_eos 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r3294 r3625  
    3131   !!   'key_zdftke'                                   TKE vertical physics 
    3232   !!---------------------------------------------------------------------- 
    33    !!   zdf_tke      : update momentum and tracer Kz from a tke scheme 
    34    !!   tke_tke      : tke time stepping: update tke at now time step (en) 
    35    !!   tke_avn      : compute mixing length scale and deduce avm and avt 
    36    !!   zdf_tke_init : initialization, namelist read, and parameters control 
    37    !!   tke_rst      : read/write tke restart in ocean restart file 
     33   !!   zdf_tke       : update momentum and tracer Kz from a tke scheme 
     34   !!   tke_tke       : tke time stepping: update tke at now time step (en) 
     35   !!   tke_avn       : compute mixing length scale and deduce avm and avt 
     36   !!   zdf_tke_init  : initialization, namelist read, and parameters control 
     37   !!   tke_rst       : read/write tke restart in ocean restart file 
    3838   !!---------------------------------------------------------------------- 
    3939   USE oce            ! ocean: dynamics and active tracers variables 
    … …  
    5252   USE wrk_nemo       ! work arrays 
    5353   USE timing         ! Timing 
     54   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    5455 
    5556   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r3294 r3625  
    1212   !!   'key_zdftmx'                                  Tidal vertical mixing 
    1313   !!---------------------------------------------------------------------- 
    14    !!   zdf_tmx      : global     momentum & tracer Kz with tidal induced Kz 
    15    !!   tmx_itf      : Indonesian momentum & tracer Kz with tidal induced Kz  
    16    !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and tracers variables 
    18    USE dom_oce         ! ocean space and time domain variables 
    19    USE zdf_oce         ! ocean vertical physics variables 
    20    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    21    USE eosbn2          ! ocean equation of state 
    22    USE phycst          ! physical constants 
    23    USE prtctl          ! Print control 
    24    USE in_out_manager  ! I/O manager 
    25    USE iom             ! I/O Manager 
    26    USE lib_mpp         ! MPP library 
    27    USE wrk_nemo        ! work arrays 
    28    USE timing          ! Timing 
     14   !!   zdf_tmx       : global     momentum & tracer Kz with tidal induced Kz 
     15   !!   tmx_itf       : Indonesian momentum & tracer Kz with tidal induced Kz  
     16   !!---------------------------------------------------------------------- 
     17   USE oce            ! ocean dynamics and tracers variables 
     18   USE dom_oce        ! ocean space and time domain variables 
     19   USE zdf_oce        ! ocean vertical physics variables 
     20   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     21   USE eosbn2         ! ocean equation of state 
     22   USE phycst         ! physical constants 
     23   USE prtctl         ! Print control 
     24   USE in_out_manager ! I/O manager 
     25   USE iom            ! I/O Manager 
     26   USE lib_mpp        ! MPP library 
     27   USE wrk_nemo       ! work arrays 
     28   USE timing         ! Timing 
     29   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2930 
    3031   IMPLICIT NONE 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3610 r3625  
    4646   USE mppini          ! shared/distributed memory setting (mpp_init routine) 
    4747   USE domain          ! domain initialization             (dom_init routine) 
     48#if defined key_nemocice_decomp 
     49   USE ice_domain_size, only: nx_global, ny_global 
     50#endif 
    4851   USE obcini          ! open boundary cond. initialization (obc_ini routine) 
    4952   USE bdyini          ! open boundary cond. initialization (bdy_init routine) 
    … …  
    259262      ! than variables 
    260263      IF( Agrif_Root() ) THEN 
     264#if defined key_nemocice_decomp 
     265         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
     266         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     267#else 
    261268         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    262 #if defined key_nemocice_decomp 
    263          jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
    264 #else 
    265269         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    266270#endif 
    … …  
    322326      IF( lk_bdy        )   CALL     tide_init      ! Open boundaries initialisation of tidal harmonic forcing 
    323327 
    324                             CALL flush(numout) 
    325328                            CALL dyn_nept_init  ! simplified form of Neptune effect 
    326                             CALL flush(numout) 
    327329 
    328330                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 

  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r3294 r3625  
    4747   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point 
    4848 
     49   !! arrays relating to embedding ice in the ocean. These arrays need to be declared  
     50   !! even if no ice model is required. In the no ice model or traditional levitating  
     51   !! ice cases they contain only zeros 
     52   !! --------------------- 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2] 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2] 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
     56 
    4957   !!---------------------------------------------------------------------- 
    5058   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    … …  
    5866      !!                   ***  FUNCTION oce_alloc  *** 
    5967      !!---------------------------------------------------------------------- 
    60       INTEGER :: ierr(2) 
     68      INTEGER :: ierr(3) 
    6169      !!---------------------------------------------------------------------- 
    6270      ! 
    … …  
    6977         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) ) 
    7078         ! 
    71       ALLOCATE(rhd (jpi,jpj,jpk) ,                                         & 
    72          &     rhop(jpi,jpj,jpk) ,                                         & 
    73          &     sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     & 
    74          &     sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     & 
    75          &     sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     & 
    76          &                         sshf_n(jpi,jpj) ,                       & 
    77          &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       & 
    78          &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     & 
    79          &     gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) ) 
     79      ALLOCATE( rhd (jpi,jpj,jpk) ,                                         & 
     80         &      rhop(jpi,jpj,jpk) ,                                         & 
     81         &      sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     & 
     82         &      sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     & 
     83         &      sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     & 
     84         &                          sshf_n(jpi,jpj) ,                       & 
     85         &      spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       & 
     86         &      gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     & 
     87         &      gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) ) 
     88         ! 
     89      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
     90         &      snwice_fmass(jpi,jpj), STAT= ierr(3) ) 
    8091         ! 
    8192      oce_alloc = MAXVAL( ierr ) 
Note: See TracChangeset for help on using the changeset viewer.