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 5630 for branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2015-07-23T18:05:51+02:00 (9 years ago)
Author:
dancopsey
Message:

Merged in revision 5518 of the trunk.

Location:
branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC
Files:
50 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r5500 r5630  
    154154      IF( lrst_oce       )   CALL rst_write( kstp )        ! write output ocean restart file 
    155155      ! 
     156#if defined key_iomput 
     157      IF( kstp == nitend .OR. indic < 0 )   CALL xios_context_finalize()   ! needed for XIOS 
     158      ! 
     159#endif 
    156160   END SUBROUTINE stp_c1d 
    157161 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r5500 r5630  
    176176 
    177177     !open output file 
    178      IF( lwp ) THEN 
     178     IF( lwm ) THEN 
    179179        CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    180180        CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    … …  
    283283           DO jsec=1,nb_sec 
    284284 
    285               IF( lwp )CALL dia_dct_wri(kt,jsec,secs(jsec)) 
     285              IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec)) 
    286286             
    287287              !nullify transports values after writing 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r5500 r5630  
    5151      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    5252      !! 
    53       INTEGER :: inum             ! temporary logical unit 
    54       INTEGER :: ji, jj, jk, jt   ! dummy loop indices 
    55       INTEGER :: ii0, ii1, ij0, ij1 
    56       REAL(wp) ::   zarea, zvol, zwei 
    57       REAL(wp) ::  ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4) 
    58       REAL(wp) ::  zt, zs, zu   
    59       REAL(wp) ::  zsm0, zfwfnew 
     53      INTEGER  :: inum             ! temporary logical unit 
     54      INTEGER  :: ji, jj, jk, jt   ! dummy loop indices 
     55      INTEGER  :: ii0, ii1, ij0, ij1 
     56      INTEGER  :: isrow         ! index for ORCA1 starting row 
     57      REAL(wp) :: zarea, zvol, zwei 
     58      REAL(wp) :: ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4) 
     59      REAL(wp) :: zt, zs, zu   
     60      REAL(wp) :: zsm0, zfwfnew 
    6061      IF( cp_cfg == "orca" .AND. jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 
    6162      !!---------------------------------------------------------------------- 
    … …  
    165166         CASE ( 1 )                                  !  ORCA_R1 configurations 
    166167            !                                        ! ======================= 
    167             ii0 = 283   ;   ii1 = 283 
    168             ij0 = 200   ;   ij1 = 200 
     168            ! This dirty section will be suppressed by simplification process: 
     169            ! all this will come back in input files 
     170            ! Currently these hard-wired indices relate to configuration with 
     171            ! extend grid (jpjglo=332) 
     172            isrow = 332 - jpjglo 
     173            ! 
     174            ii0 = 283           ;   ii1 = 283 
     175            ij0 = 241 - isrow   ;   ij1 = 241 - isrow 
    169176            !                                        ! ======================= 
    170177         CASE DEFAULT                                !    ORCA R05 or R025 
    … …  
    212219         CASE ( 1 )                                  !  ORCA_R1 configurations 
    213220            !                                        ! ======================= 
    214             ii0 = 282   ;   ii1 = 282 
    215             ij0 = 200   ;   ij1 = 200 
     221            ! This dirty section will be suppressed by simplification process: 
     222            ! all this will come back in input files 
     223            ! Currently these hard-wired indices relate to configuration with 
     224            ! extend grid (jpjglo=332) 
     225            isrow = 332 - jpjglo 
     226            ii0 = 282           ;   ii1 = 282 
     227            ij0 = 240 - isrow   ;   ij1 = 240 - isrow 
    216228            !                                        ! ======================= 
    217229         CASE DEFAULT                                !    ORCA R05 or R025 
    … …  
    259271         CASE ( 1 )                                  !  ORCA_R1 configurations 
    260272            !                                        ! ======================= 
    261             ii0 = 331   ;   ii1 = 331 
    262             ij0 = 176   ;   ij1 = 176 
     273            ! This dirty section will be suppressed by simplification process: 
     274            ! all this will come back in input files 
     275            ! Currently these hard-wired indices relate to configuration with 
     276            ! extend grid (jpjglo=332) 
     277            isrow = 332 - jpjglo 
     278            ii0 = 331           ;   ii1 = 331 
     279            ij0 = 215 - isrow   ;   ij1 = 215 - isrow 
    263280            !                                        ! ======================= 
    264281         CASE DEFAULT                                !    ORCA R05 or R025 
    … …  
    306323         CASE ( 1 )                                  !  ORCA_R1 configurations 
    307324            !                                        ! ======================= 
    308             ii0 = 297   ;   ii1 = 297  
    309             ij0 = 230   ;   ij1 = 230 
     325            ! This dirty section will be suppressed by simplification process: 
     326            ! all this will come back in input files 
     327            ! Currently these hard-wired indices relate to configuration with 
     328            ! extend grid (jpjglo=332) 
     329            isrow = 332 - jpjglo 
     330            ii0 = 297           ;   ii1 = 297 
     331            ij0 = 269 - isrow   ;   ij1 = 269 - isrow 
    310332            !                                        ! ======================= 
    311333         CASE DEFAULT                                !    ORCA R05 or R025 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r5500 r5630  
    245245      CALL iom_put( "mldr10_3", zrho10_3     )   ! MLD delta rho(10m) = 0.03 
    246246      CALL iom_put( "pycndep" , zpycn        )   ! MLD delta rho equi. delta T(10m) = 0.2 
    247       CALL iom_put( "BLT"     , ztm2 - zpycn )   ! Barrier Layer Thickness 
    248247      CALL iom_put( "tinv"    , ztinv        )   ! max. temp. inv. (t10 ref)  
    249248      CALL iom_put( "depti"   , zdepinv      )   ! depth of max. temp. inv. (t10 ref)  

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5500 r5630  
    4646   USE iom 
    4747   USE ioipsl 
     48   USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities      
     49 
    4850#if defined key_lim2 
    4951   USE limwri_2  
    … …  
    125127      !! 
    126128      INTEGER                      ::   ji, jj, jk              ! dummy loop indices 
     129      INTEGER                      ::   jkbot                   ! 
    127130      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    128131      !! 
    … …  
    148151         CALL iom_put( "e3w" , fse3w_n(:,:,:) ) 
    149152      ENDIF 
     153 
     154      CALL iom_put( "ssh" , sshn )                 ! sea surface height 
     155      if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
    150156       
    151157      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature 
    … …  
    154160         DO jj = 1, jpj 
    155161            DO ji = 1, jpi 
    156                z2d(ji,jj) = tsn(ji,jj,MAX(mbathy(ji,jj),1),jp_tem) 
     162               jkbot = mbkt(ji,jj) 
     163               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem) 
    157164            END DO 
    158165         END DO 
    … …  
    165172         DO jj = 1, jpj 
    166173            DO ji = 1, jpi 
    167                z2d(ji,jj) = tsn(ji,jj,MAX(mbathy(ji,jj),1),jp_sal) 
     174               jkbot = mbkt(ji,jj) 
     175               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal) 
    168176            END DO 
    169177         END DO 
    170178         CALL iom_put( "sbs", z2d )                ! bottom salinity 
     179      ENDIF 
     180 
     181      IF ( iom_use("taubot") ) THEN                ! bottom stress 
     182         z2d(:,:) = 0._wp 
     183         DO jj = 2, jpjm1 
     184            DO ji = fs_2, fs_jpim1   ! vector opt. 
     185               zztmpx = (  bfrua(ji  ,jj) * un(ji  ,jj,mbku(ji  ,jj))  & 
     186                      &  + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj))  )       
     187               zztmpy = (  bfrva(ji,  jj) * vn(ji,jj  ,mbkv(ji,jj  ))  & 
     188                      &  + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1))  )  
     189               z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)  
     190               ! 
     191            ENDDO 
     192         ENDDO 
     193         CALL lbc_lnk( z2d, 'T', 1. ) 
     194         CALL iom_put( "taubot", z2d )            
    171195      ENDIF 
    172196          
    … …  
    176200         DO jj = 1, jpj 
    177201            DO ji = 1, jpi 
    178                z2d(ji,jj) = un(ji,jj,MAX(mbathy(ji,jj),1)) 
     202               jkbot = mbku(ji,jj) 
     203               z2d(ji,jj) = un(ji,jj,jkbot) 
    179204            END DO 
    180205         END DO 
    181206         CALL iom_put( "sbu", z2d )                ! bottom i-current 
    182207      ENDIF 
     208#if defined key_dynspg_ts 
     209      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current 
     210#else 
     211      CALL iom_put(  "ubar", un_b(:,:)        )    ! barotropic i-current 
     212#endif 
    183213       
    184214      CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current 
    … …  
    187217         DO jj = 1, jpj 
    188218            DO ji = 1, jpi 
    189                z2d(ji,jj) = vn(ji,jj,MAX(mbathy(ji,jj),1)) 
     219               jkbot = mbkv(ji,jj) 
     220               z2d(ji,jj) = vn(ji,jj,jkbot) 
    190221            END DO 
    191222         END DO 
    192223         CALL iom_put( "sbv", z2d )                ! bottom j-current 
     224      ENDIF 
     225#if defined key_dynspg_ts 
     226      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic j-current 
     227#else 
     228      CALL iom_put(  "vbar", vn_b(:,:)        )    ! barotropic j-current 
     229#endif 
     230 
     231      CALL iom_put( "woce", wn )                   ! vertical velocity 
     232      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
     233         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
     234         z2d(:,:) = rau0 * e12t(:,:) 
     235         DO jk = 1, jpk 
     236            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     237         END DO 
     238         CALL iom_put( "w_masstr" , z3d )   
     239         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
    193240      ENDIF 
    194241 
    … …  
    593640         ENDIF 
    594641 
    595          IF( .NOT. lk_cpl ) THEN 
     642         IF( .NOT. ln_cpl ) THEN 
    596643            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    597644               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    602649         ENDIF 
    603650 
    604          IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     651         IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    605652            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    606653               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    625672#endif 
    626673 
    627          IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     674         IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    628675            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    629676               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    780827      ENDIF 
    781828 
    782       IF( .NOT. lk_cpl ) THEN 
     829      IF( .NOT. ln_cpl ) THEN 
    783830         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    784831         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    … …  
    786833         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    787834      ENDIF 
    788       IF( lk_cpl .AND. nn_ice <= 1 ) THEN 
     835      IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
    789836         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    790837         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    … …  
    802849#endif 
    803850 
    804       IF( lk_cpl .AND. nn_ice == 2 ) THEN 
     851      IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    805852         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    806853         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r5500 r5630  
    7272      !!---------------------------------------------------------------------- 
    7373      INTEGER ::   jc            ! dummy loop indices 
     74      INTEGER :: isrow           ! local index 
    7475      !!---------------------------------------------------------------------- 
    7576       
    … …  
    9192         CASE ( 1 )                                  ! ORCA_R1 configuration 
    9293            !                                        ! ======================= 
     94            ! This dirty section will be suppressed by simplification process: 
     95            ! all this will come back in input files 
     96            ! Currently these hard-wired indices relate to configuration with 
     97            ! extend grid (jpjglo=332) 
     98            isrow = 332 - jpjglo 
     99            ! 
    93100            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea 
    94             ncsi1(1)   = 332  ; ncsj1(1)   = 203 
    95             ncsi2(1)   = 344  ; ncsj2(1)   = 235 
     101            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow 
     102            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow 
    96103            ncsir(1,1) = 1    ; ncsjr(1,1) = 1 
    97104            !                                         

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5500 r5630  
    136136      USE ioipsl 
    137137      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
     138         &             ln_rstdate,                                                                 & 
    138139         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
    139140         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    140          &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz, nn_euler ,   & 
    141          &             ln_rstdate 
     141         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    142142      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
    143143         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  & 
    … …  
    191191         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn 
    192192         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland 
     193         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta 
    193194         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber 
    194195         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r5500 r5630  
    105105      REAL(wp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg 
    106106      REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05 
     107      INTEGER  ::   isrow                ! index for ORCA1 starting row 
     108 
    107109      !!---------------------------------------------------------------------- 
    108110      ! 
    … …  
    159161         IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    160162            !                                             ! ===================== 
    161  
    162             ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u = 20 km) 
    163             ij0 = 200   ;   ij1 = 200   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3 
     163            ! This dirty section will be suppressed by simplification process: all this will come back in input files 
     164            ! Currently these hard-wired indices relate to configuration with 
     165            ! extend grid (jpjglo=332) 
     166            ! which had a grid-size of 362x292. 
     167            !  
     168            isrow = 332 - jpjglo 
     169            ! 
     170            ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u = 20 km) 
     171            ij0 = 201 + isrow   ;   ij1 = 241 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3 
    164172            IF(lwp) WRITE(numout,*) 
    165173            IF(lwp) WRITE(numout,*) '             orca_r1: Gibraltar : e2u reduced to 20 km' 
    166174 
    167             ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km) 
    168             ij0 = 208   ;   ij1 = 208   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
     175            ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km) 
     176            ij0 = 208 + isrow   ;   ij1 = 248 - isrow   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3 
    169177            IF(lwp) WRITE(numout,*) 
    170178            IF(lwp) WRITE(numout,*) '             orca_r1: Bhosporus : e2u reduced to 10 km' 
    171179 
    172             ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v = 13 km) 
    173             ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3 
     180            ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v = 13 km) 
     181            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3 
    174182            IF(lwp) WRITE(numout,*) 
    175183            IF(lwp) WRITE(numout,*) '             orca_r1: Lombok : e1v reduced to 10 km' 
    176184 
    177             ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 
    178             ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3 
     185            ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 
     186            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3 
    179187            IF(lwp) WRITE(numout,*) 
    180188            IF(lwp) WRITE(numout,*) '             orca_r1: Sumba : e1v reduced to 8 km' 
    181189 
    182             ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v = 13 km) 
    183             ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3 
     190            ii0 =  53           ;   ii1 =  53        ! Ombai Strait (e1v = 13 km) 
     191            ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3 
    184192            IF(lwp) WRITE(numout,*) 
    185193            IF(lwp) WRITE(numout,*) '             orca_r1: Ombai : e1v reduced to 13 km' 
    186194 
    187             ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v = 20 km) 
    188             ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3 
     195            ii0 =  56           ;   ii1 =  56        ! Timor Passage (e1v = 20 km) 
     196            ij0 = 124 + isrow   ;   ij1 = 145 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3 
    189197            IF(lwp) WRITE(numout,*) 
    190198            IF(lwp) WRITE(numout,*) '             orca_r1: Timor Passage : e1v reduced to 20 km' 
    191199 
    192             ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km) 
    193             ij0 = 141   ;   ij1 = 142   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3 
     200            ii0 =  55           ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km) 
     201            ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3 
    194202            IF(lwp) WRITE(numout,*) 
    195203            IF(lwp) WRITE(numout,*) '             orca_r1: W Halmahera : e1v reduced to 30 km' 
    196204 
    197             ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km) 
    198             ij0 = 141   ;   ij1 = 142   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3 
     205            ii0 =  58           ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km) 
     206            ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3 
    199207            IF(lwp) WRITE(numout,*) 
    200208            IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km' 
    201  
    202             ! 
    203  
    204             ! 
    205             ! 
    206209            ! 
    207210            ! 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r5500 r5630  
    134134      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       - 
    135135      INTEGER  ::   ios 
     136      INTEGER  ::   isrow                    ! index for ORCA1 starting row 
    136137      INTEGER , POINTER, DIMENSION(:,:) ::  imsk 
    137138      REAL(wp), POINTER, DIMENSION(:,:) ::  zwf 
    … …  
    401402      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration 
    402403         !                                                 ! Increased lateral friction near of some straits 
     404         ! This dirty section will be suppressed by simplification process: 
     405         ! all this will come back in input files 
     406         ! Currently these hard-wired indices relate to configuration with 
     407         ! extend grid (jpjglo=332) 
     408         ! 
     409         isrow = 332 - jpjglo 
     410         ! 
    403411         IF(lwp) WRITE(numout,*) 
    404412         IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : ' 
    405413         IF(lwp) WRITE(numout,*) '      Gibraltar ' 
    406          ii0 = 283   ;   ii1 = 284        ! Gibraltar Strait  
    407          ij0 = 200   ;   ij1 = 200   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp   
     414         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait  
     415         ij0 = 201 + isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    408416 
    409417         IF(lwp) WRITE(numout,*) '      Bhosporus ' 
    410          ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait  
    411          ij0 = 208   ;   ij1 = 208   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp   
     418         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait  
     419         ij0 = 208 + isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    412420 
    413421         IF(lwp) WRITE(numout,*) '      Makassar (Top) ' 
    414          ii0 =  48   ;   ii1 =  48        ! Makassar Strait (Top)  
    415          ij0 = 149   ;   ij1 = 150   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp   
     422         ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)  
     423         ij0 = 149 + isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    416424 
    417425         IF(lwp) WRITE(numout,*) '      Lombok ' 
    418          ii0 =  44   ;   ii1 =  44        ! Lombok Strait  
    419          ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp   
     426         ii0 =  44           ;   ii1 =  44        ! Lombok Strait  
     427         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    420428 
    421429         IF(lwp) WRITE(numout,*) '      Ombai ' 
    422          ii0 =  53   ;   ii1 =  53        ! Ombai Strait  
    423          ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp   
     430         ii0 =  53           ;   ii1 =  53        ! Ombai Strait  
     431         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    424432 
    425433         IF(lwp) WRITE(numout,*) '      Timor Passage ' 
    426          ii0 =  56   ;   ii1 =  56        ! Timor Passage  
    427          ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp   
     434         ii0 =  56           ;   ii1 =  56        ! Timor Passage  
     435         ij0 = 124 + isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    428436 
    429437         IF(lwp) WRITE(numout,*) '      West Halmahera ' 
    430          ii0 =  58   ;   ii1 =  58        ! West Halmahera Strait  
    431          ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp   
     438         ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait  
     439         ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    432440 
    433441         IF(lwp) WRITE(numout,*) '      East Halmahera ' 
    434          ii0 =  55   ;   ii1 =  55        ! East Halmahera Strait  
    435          ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp   
     442         ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait  
     443         ij0 = 141 + isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    436444         ! 
    437445      ENDIF 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5500 r5630  
    10391039      INTEGER ::   ji, jj, jk                                          ! dummy loop indices 
    10401040      INTEGER ::   ij0, ij1, ii0, ii1                                  ! dummy loop indices 
     1041      INTEGER ::   isrow                                               ! index for ORCA1 starting row 
    10411042      !! acc 
    10421043      !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for 
    … …  
    11221123      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    11231124         !                                             ! ===================== 
    1124          ! 
    1125          ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u was modified) 
    1126          ij0 = 200   ;   ij1 = 200 
     1125         ! This dirty section will be suppressed by simplification process: 
     1126         ! all this will come back in input files 
     1127         ! Currently these hard-wired indices relate to configuration with 
     1128         ! extend grid (jpjglo=332) 
     1129         ! which had a grid-size of 362x292. 
     1130         isrow = 332 - jpjglo 
     1131         ! 
     1132         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait (e2u was modified) 
     1133         ij0 = 241 - isrow   ;   ij1 = 241 - isrow 
    11271134         DO jk = 1, jpkm1 
    11281135            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    11441151         END DO 
    11451152         ! 
    1146          ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u was modified) 
    1147          ij0 = 208   ;   ij1 = 208 
     1153         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u was modified) 
     1154         ij0 = 248 - isrow   ;   ij1 = 248 - isrow 
    11481155         DO jk = 1, jpkm1 
    11491156            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    11651172         END DO 
    11661173         ! 
    1167          ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v was modified) 
    1168          ij0 = 124   ;   ij1 = 125 
     1174         ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v was modified) 
     1175         ij0 = 164 - isrow   ;   ij1 = 165 - isrow 
    11691176         DO jk = 1, jpkm1 
    11701177            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    11811188         END DO 
    11821189         ! 
    1183          ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 
    1184          ij0 = 124   ;   ij1 = 125 
     1190         ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 
     1191         ij0 = 164 - isrow   ;   ij1 = 165 - isrow 
    11851192         DO jk = 1, jpkm1 
    11861193            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    11971204         END DO 
    11981205         ! 
    1199          ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v was modified) 
    1200          ij0 = 124   ;   ij1 = 125 
     1206         ii0 =  53          ;   ii1 =  53        ! Ombai Strait (e1v was modified) 
     1207         ij0 = 164 - isrow  ;   ij1 = 165  - isrow   
    12011208         DO jk = 1, jpkm1 
    12021209            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    12131220         END DO 
    12141221         ! 
    1215          ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v was modified) 
    1216          ij0 = 124   ;   ij1 = 125 
     1222         ii0 =  56            ;   ii1 =  56        ! Timor Passage (e1v was modified) 
     1223         ij0 = 164 - isrow    ;   ij1 = 165  - isrow   
    12171224         DO jk = 1, jpkm1 
    12181225            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    12291236         END DO 
    12301237         ! 
    1231          ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v was modified) 
    1232          ij0 = 141   ;   ij1 = 142 
     1238         ii0 =  55            ;   ii1 =  55        ! West Halmahera Strait (e1v was modified) 
     1239         ij0 = 181 - isrow    ;   ij1 = 182 - isrow   
    12331240         DO jk = 1, jpkm1 
    12341241            DO jj = mj0(ij0), mj1(ij1) 
    … …  
    12451252         END DO 
    12461253         ! 
    1247          ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v was modified) 
    1248          ij0 = 141   ;   ij1 = 142 
     1254         ii0 =  58            ;   ii1 =  58        ! East Halmahera Strait (e1v was modified) 
     1255         ij0 = 181 - isrow    ;   ij1 = 182 - isrow   
    12491256         DO jk = 1, jpkm1 
    12501257            DO jj = mj0(ij0), mj1(ij1) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r5500 r5630  
    9898      ! 
    9999      CALL wrk_alloc( jpi  , jpj+2, zwu               ) 
    100       CALL wrk_alloc( jpi+4, jpj  , zwv, kjstart = -1 ) 
     100      CALL wrk_alloc( jpi+4, jpj  , zwv, kistart = -1 ) 
    101101      ! 
    102102      IF( kt == nit000 ) THEN 
    … …  
    237237      ! 
    238238      CALL wrk_dealloc( jpi  , jpj+2, zwu               ) 
    239       CALL wrk_dealloc( jpi+4, jpj  , zwv, kjstart = -1 ) 
     239      CALL wrk_dealloc( jpi+4, jpj  , zwv, kistart = -1 ) 
    240240      ! 
    241241      IF( nn_timing == 1 )  CALL timing_stop('div_cur') 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r5500 r5630  
    266266               ! Add volume filter correction: compatibility with tracer advection scheme 
    267267               ! => time filter + conservation correction (only at the first level) 
    268                fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
    269             ! 
     268               fse3t_b(:,:,1) = fse3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 
     269                              &                                          -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
    270270            ENDIF 
    271271            ! 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r5500 r5630  
    462462      !                                         ! Include the IAU weighted SSH increment 
    463463      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    464          zssh_frc(:,:) = zssh_frc(:,:) + ssh_iau(:,:) 
     464         zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 
    465465      ENDIF 
    466466#endif 
    … …  
    557557               END DO 
    558558            END DO 
    559             CALL lbc_lnk( zwx, 'U', 1._wp )    ;   CALL lbc_lnk( zwy, 'V', 1._wp ) 
     559            CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 
    560560            ! 
    561561            zhup2_e (:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points 
    … …  
    635635               END DO 
    636636            END DO 
    637             CALL lbc_lnk( zsshu_a, 'U', 1._wp )   ;   CALL lbc_lnk( zsshv_a, 'V', 1._wp ) 
     637            CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) 
    638638         ENDIF    
    639639         !                                  
    … …  
    803803         !                                                 !  ----------------------- 
    804804         ! 
    805          CALL lbc_lnk( ua_e  , 'U', -1._wp )               ! local domain boundaries  
    806          CALL lbc_lnk( va_e  , 'V', -1._wp ) 
     805         CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp ) 
    807806 
    808807#if defined key_bdy   
    … …  
    859858            END DO 
    860859         END DO 
    861          CALL lbc_lnk( zsshu_a, 'U', 1._wp )   ;   CALL lbc_lnk( zsshv_a, 'V', 1._wp ) ! Boundary conditions 
     860         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    862861      ENDIF 
    863862      ! 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r5500 r5630  
    2121   USE domvvl          ! Variable volume 
    2222   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    23    USE iom             ! I/O library 
    2423   USE restart         ! only for lrst_oce 
    2524   USE in_out_manager  ! I/O manager 
    … …  
    3130   USE bdy_par          
    3231   USE bdydyn2d        ! bdy_ssh routine 
    33    USE iom 
    3432#if defined key_agrif 
    3533   USE agrif_opa_update 
    … …  
    137135      !                                           !           outputs            ! 
    138136      !                                           !------------------------------! 
    139       CALL iom_put( "ssh" , sshn )   ! sea surface height 
    140       if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
    141137      ! 
    142138      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 ) 
    … …  
    228224#endif 
    229225      ! 
    230       !                                           !------------------------------! 
    231       !                                           !           outputs            ! 
    232       !                                           !------------------------------! 
    233       CALL iom_put( "woce", wn )   ! vertical velocity 
    234       IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    235          CALL wrk_alloc( jpi, jpj, z2d )  
    236          CALL wrk_alloc( jpi, jpj, jpk, z3d )  
    237          ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    238          z2d(:,:) = rau0 * e12t(:,:) 
    239          DO jk = 1, jpk 
    240             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
    241          END DO 
    242          CALL iom_put( "w_masstr" , z3d )   
    243          IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
    244          CALL wrk_dealloc( jpi, jpj, z2d  )  
    245          CALL wrk_dealloc( jpi, jpj, jpk, z3d )  
    246       ENDIF 
    247       ! 
    248226      IF( nn_timing == 1 )  CALL timing_stop('wzv') 
    249227 
    … …  
    290268      ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap 
    291269         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )     ! before <-- now filtered 
    292          IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) ) * ssmask(:,:) 
     270         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) - rnf_b(:,:) + rnf(:,:) ) * ssmask(:,:) 
    293271         sshn(:,:) = ssha(:,:)                           ! now <-- after 
    294272      ENDIF 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r5526 r5630  
    233233      INTEGER ::   jn   ! dummy loop index 
    234234      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
    235       INTEGER                :: iyear, imonth, iday   
     235      INTEGER                :: iyear, imonth, iday 
    236236      REAL (wp)              :: zsec 
    237237      CHARACTER(len=256)     :: cl_path 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r5500 r5630  
    4545                                                       !:                  (T): 1 file per proc 
    4646   LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%) 
    47    LOGICAL       ::   ln_rstdate    = .FALSE.     !: Use calendar date rather than time-step in restart names 
     47   LOGICAL       ::   ln_rstdate    = .FALSE.     !: Use calendar date rather than time-step in restart names  
     48   LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard 
    4849   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file 
    4950   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
    … …  
    9091   INTEGER ::   nitrst                !: time step at which restart file should be written 
    9192   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    92    INTEGER ::   numror, numrow        !: logical unit for cean restart (read and write) 
     93   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 
     94   INTEGER ::   numrow                !: logical unit for ocean restart (write) 
     95   INTEGER ::   nrst_lst              !: number of restart to output next 
    9396   INTEGER ::   nrst_lst              !: number of restart to output next 
    9497 
    … …  
    149152   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl 
    150153   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area 
     154   CHARACTER(lc) ::   cxios_context         !: context name used in xios 
    151155 
    152156   !!---------------------------------------------------------------------- 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5500 r5630  
    6161#if defined key_iomput 
    6262   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 
    63    PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 
     63   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 
    6464# endif 
    6565 
    … …  
    9898      CHARACTER(len=10) :: clname 
    9999      INTEGER           ::   ji 
    100       !!---------------------------------------------------------------------- 
     100      ! 
     101      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
     102      !!---------------------------------------------------------------------- 
     103 
     104      ALLOCATE( z_bnds(jpk,2) ) 
    101105 
    102106      clname = cdname 
    103107      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 
    104 # if defined key_mpp_mpi 
    105108      CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 
    106 # else 
    107       CALL xios_context_initialize(TRIM(clname), 0) 
    108 # endif 
    109109      CALL iom_swap( cdname ) 
    110110 
    … …  
    121121      CALL set_scalar 
    122122 
    123       IF( TRIM(cdname) == "nemo" ) THEN   
     123      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    124124         CALL set_grid( "T", glamt, gphit )  
    125125         CALL set_grid( "U", glamu, gphiu ) 
    126126         CALL set_grid( "V", glamv, gphiv ) 
    127127         CALL set_grid( "W", glamt, gphit ) 
    128       ENDIF 
    129  
    130       IF( TRIM(cdname) == "nemo_crs" ) THEN   
     128         CALL set_grid_znl( gphit ) 
     129         ! 
     130         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
     131            CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej)) 
     132            CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej)) 
     133            CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej)) 
     134            CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej)) 
     135            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
     136            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
     137            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 
     138            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 
     139         ENDIF 
     140      ENDIF 
     141 
     142      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN   
    131143         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    132144         ! 
    … …  
    135147         CALL set_grid( "V", glamv_crs, gphiv_crs )  
    136148         CALL set_grid( "W", glamt_crs, gphit_crs )  
     149         CALL set_grid_znl( gphit_crs ) 
    137150          ! 
    138151         CALL dom_grid_glo   ! Return to parent grid domain 
    139       ENDIF 
    140  
     152         ! 
     153         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
     154            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
     155            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 
     156            CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej)) 
     157            CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
     158            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
     159            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 
     160            CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs ) 
     161            CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
     162         ENDIF 
     163      ENDIF 
    141164 
    142165      ! vertical grid definition 
    … …  
    145168      CALL iom_set_axis_attr( "depthv", gdept_1d ) 
    146169      CALL iom_set_axis_attr( "depthw", gdepw_1d ) 
     170 
     171      ! Add vertical grid bounds 
     172      z_bnds(:      ,1) = gdepw_1d(:) 
     173      z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
     174      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
     175      CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
     176      CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
     177      CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
     178      z_bnds(:    ,2) = gdept_1d(:) 
     179      z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 
     180      z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1) 
     181      CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
     182 
    147183# if defined key_floats 
    148184      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 
    … …  
    152188#endif 
    153189      CALL iom_set_axis_attr( "icbcla", class_num ) 
     190      CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 
     191      CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 
    154192       
    155193      ! automatic definitions of some of the xml attributs 
    … …  
    162200       
    163201      CALL xios_update_calendar(0) 
     202 
     203      DEALLOCATE( z_bnds ) 
     204 
    164205#endif 
    165206       
    … …  
    11071148 
    11081149   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   & 
    1109       &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 
    1110       CHARACTER(LEN=*)                 , INTENT(in) ::   cdid 
    1111       INTEGER                , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
    1112       INTEGER                , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    1113       INTEGER                , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 
    1114       REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1115       LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) ::   mask 
     1150      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     & 
     1151      &                                    nvertex, bounds_lon, bounds_lat, area ) 
     1152      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
     1153      INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
     1154      INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
     1155      INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 
     1156      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     1157      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
     1158      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
    11161159 
    11171160      IF ( xios_is_valid_domain     (cdid) ) THEN 
    … …  
    11191162            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    11201163            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1121             &    lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 
     1164            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
     1165            &    bounds_lat=bounds_lat, area=area ) 
    11221166      ENDIF 
    11231167 
    … …  
    11261170            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
    11271171            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       & 
    1128             &    lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 
     1172            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
     1173            &    bounds_lat=bounds_lat, area=area ) 
    11291174      ENDIF 
    11301175      CALL xios_solve_inheritance() 
    … …  
    11331178 
    11341179 
    1135    SUBROUTINE iom_set_axis_attr( cdid, paxis ) 
     1180   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 
    11361181      CHARACTER(LEN=*)      , INTENT(in) ::   cdid 
    1137       REAL(wp), DIMENSION(:), INTENT(in) ::   paxis 
    1138       IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=size(paxis),value=paxis ) 
    1139       IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 
     1182      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis 
     1183      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds 
     1184      IF ( PRESENT(paxis) ) THEN 
     1185         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis ) 
     1186         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 
     1187      ENDIF 
     1188      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
     1189      IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 
    11401190      CALL xios_solve_inheritance() 
    11411191   END SUBROUTINE iom_set_axis_attr 
    … …  
    12001250      CALL iom_swap( cdname )   ! swap to cdname context 
    12011251      CALL xios_update_calendar(kt) 
    1202       IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context 
     1252      IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    12031253      ! 
    12041254   END SUBROUTINE iom_setkt 
    … …  
    12101260         CALL iom_swap( cdname )   ! swap to cdname context 
    12111261         CALL xios_context_finalize() ! finalize the context 
    1212          IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context 
     1262         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    12131263      ENDIF 
    12141264      ! 
    … …  
    12531303 
    12541304 
     1305   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 
     1306      !!---------------------------------------------------------------------- 
     1307      !!                   ***  ROUTINE set_grid_bounds  *** 
     1308      !! 
     1309      !! ** Purpose :   define horizontal grid corners 
     1310      !! 
     1311      !!---------------------------------------------------------------------- 
     1312      CHARACTER(LEN=1) , INTENT(in) :: cdgrd 
     1313      ! 
     1314      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: plon_cnr, plat_cnr  ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 
     1315      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coordinates of the point of cell (i,j) 
     1316      ! 
     1317      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
     1318      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells 
     1319      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells 
     1320      ! 
     1321      INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
     1322      !                                                          ! represents the bottom-left corner of cell (i,j) 
     1323      INTEGER :: ji, jj, jn, ni, nj 
     1324 
     1325      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  ) 
     1326 
     1327      ! Offset of coordinate representing bottom-left corner 
     1328      SELECT CASE ( TRIM(cdgrd) ) 
     1329         CASE ('T', 'W') 
     1330            icnr = -1 ; jcnr = -1 
     1331         CASE ('U') 
     1332            icnr =  0 ; jcnr = -1 
     1333         CASE ('V') 
     1334            icnr = -1 ; jcnr =  0 
     1335      END SELECT 
     1336 
     1337      ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior 
     1338 
     1339      z_fld(:,:) = 1._wp 
     1340      CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold 
     1341 
     1342      ! Cell vertices that can be defined 
     1343      DO jj = 2, jpjm1 
     1344         DO ji = 2, jpim1 
     1345            z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     1346            z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     1347            z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     1348            z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     1349            z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     1350            z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     1351            z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     1352            z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     1353         END DO 
     1354      END DO 
     1355 
     1356      ! Cell vertices on boundries 
     1357      DO jn = 1, 4 
     1358         CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 
     1359         CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 
     1360      END DO 
     1361 
     1362      ! Zero-size cells at closed boundaries if cell points provided, 
     1363      ! otherwise they are closed cells with unrealistic bounds 
     1364      IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 
     1365         IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
     1366            DO jn = 1, 4        ! (West or jpni = 1), closed E-W 
     1367               z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:) 
     1368            END DO 
     1369         ENDIF 
     1370         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
     1371            DO jn = 1, 4        ! (East or jpni = 1), closed E-W 
     1372               z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 
     1373            END DO 
     1374         ENDIF 
     1375         IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 
     1376            DO jn = 1, 4        ! South or (jpnj = 1, not symmetric) 
     1377               z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1) 
     1378            END DO 
     1379         ENDIF 
     1380         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
     1381            DO jn = 1, 4        ! (North or jpnj = 1), no north fold 
     1382               z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 
     1383            END DO 
     1384         ENDIF 
     1385      ENDIF 
     1386 
     1387      ! Rotate cells at the north fold 
     1388      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 
     1389         DO jj = 1, jpj 
     1390            DO ji = 1, jpi 
     1391               IF( z_fld(ji,jj) == -1. ) THEN 
     1392                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
     1393                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
     1394                  z_bnds(:,ji,jj,:) = z_rot(:,:) 
     1395               ENDIF 
     1396            END DO 
     1397         END DO 
     1398 
     1399      ! Invert cells at the symmetric equator 
     1400      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 
     1401         DO ji = 1, jpi 
     1402            z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
     1403            z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 
     1404            z_bnds(:,ji,1,:) = z_rot(:,:) 
     1405         END DO 
     1406      ENDIF 
     1407 
     1408      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           & 
     1409                                               bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
     1410 
     1411      DEALLOCATE( z_bnds, z_fld, z_rot )  
     1412 
     1413   END SUBROUTINE set_grid_bounds 
     1414 
     1415 
     1416   SUBROUTINE set_grid_znl( plat ) 
     1417      !!---------------------------------------------------------------------- 
     1418      !!                     ***  ROUTINE set_grid_znl  *** 
     1419      !! 
     1420      !! ** Purpose :   define grids for zonal mean 
     1421      !! 
     1422      !!---------------------------------------------------------------------- 
     1423      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
     1424      ! 
     1425      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
     1426      INTEGER  :: ni,nj, ix, iy 
     1427 
     1428       
     1429      ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk) 
     1430      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
     1431 
     1432      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1433      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1434      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
     1435         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     1436      ! 
     1437      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1438      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
     1439      CALL iom_update_file_name('ptr') 
     1440      ! 
     1441   END SUBROUTINE set_grid_znl 
     1442 
    12551443   SUBROUTINE set_scalar 
    12561444      !!---------------------------------------------------------------------- 
    … …  
    12601448      !! 
    12611449      !!---------------------------------------------------------------------- 
    1262       REAL(wp), DIMENSION(1) ::   zz = 1. 
     1450      REAL(wp), DIMENSION(1)   ::   zz = 1. 
    12631451      !!---------------------------------------------------------------------- 
    12641452      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
    12651453      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 
     1454       
    12661455      zz=REAL(narea,wp) 
    12671456      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    … …  
    13371526      CALL set_mooring( zlonpira, zlatpira ) 
    13381527 
    1339       ! diaptr : zonal mean  
    1340       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    1341       CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
    1342       CALL iom_update_file_name('ptr') 
    1343       ! 
    13441528       
    13451529   END SUBROUTINE set_xmlatt 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5500 r5630  
    2525   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
    2626   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    27    USE sbc_ice, ONLY : lk_lim3 
    2827 
    2928   IMPLICIT NONE 
    … …  
    8685         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN  
    8786            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    88             IF ( ln_rstdate ) THEN  
    89                CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec )             
    90                WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday  
    91             ELSE  
    92                IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst  
    93                ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst  
    94                ENDIF 
     87            IF ( ln_rstdate ) THEN   
     88               CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec )              
     89               WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday   
     90            ELSE   
     91               IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst   
     92               ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst   
    9593            ENDIF 
    9694            ! create the file 
    … …  
    143141                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      ) 
    144142                     ! 
    145       IF( lk_lim3 )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
    146                      ! 
    147143                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
    148144                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        ) 
    … …  
    156152                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       ) 
    157153#endif 
    158                   IF( lk_lim3 ) THEN 
    159                      CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif 
    160                   ENDIF 
    161154      IF( kt == nitrst ) THEN 
    162155         CALL iom_close( numrow )     ! close the restart file (only at last time step) 
    … …  
    244237         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    245238         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
    246          IF( lk_lim3 )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    247239      ELSE 
    248240         neuler = 0 
    … …  
    287279         ENDIF 
    288280 
    289          IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN 
    290             DO jk = 1, jpk 
    291                fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
    292             END DO 
    293          ENDIF 
    294  
    295       ENDIF 
    296       ! 
    297       IF( lk_lim3 ) THEN 
    298          CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 
    299281      ENDIF 
    300282      ! 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r5500 r5630  
    2222   USE lib_mpp          ! distributed memory computing library 
    2323 
     24 
     25   INTERFACE lbc_lnk_multi 
     26      MODULE PROCEDURE mpp_lnk_2d_9 
     27   END INTERFACE 
     28 
    2429   INTERFACE lbc_lnk 
    2530      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 
    … …  
    3944 
    4045   PUBLIC lbc_lnk       ! ocean lateral boundary conditions 
     46   PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 
    4147   PUBLIC lbc_lnk_e 
    4248   PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r5500 r5630  
    7171   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
    7272   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
     73   PUBLIC   mpp_lnk_2d_9  
    7374   PUBLIC   mppscatter, mppgather 
    7475   PUBLIC   mpp_ini_ice, mpp_ini_znl 
    … …  
    7879   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb 
    7980 
     81   TYPE arrayptr 
     82      REAL , DIMENSION (:,:),  POINTER :: pt2d 
     83   END TYPE arrayptr 
     84    
    8085   !! * Interfaces 
    8186   !! define generic interface for these routine as they are called sometimes 
    … …  
    164169 
    165170 
    166    FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 
     171   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 
    167172      !!---------------------------------------------------------------------- 
    168173      !!                  ***  routine mynode  *** 
    … …  
    171176      !!---------------------------------------------------------------------- 
    172177      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
     178      CHARACTER(len=*)             , INTENT(in   ) ::   ldname 
    173179      INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist 
    174180      INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist 
    … …  
    297303 
    298304      IF( mynode == 0 ) THEN 
    299         CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    300         WRITE(kumond, nammpp)       
     305         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     306         WRITE(kumond, nammpp)       
    301307      ENDIF 
    302308      ! 
    … …  
    510516      ! 
    511517   END SUBROUTINE mpp_lnk_3d 
     518 
     519   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval ) 
     520      !!---------------------------------------------------------------------- 
     521      !!                  ***  routine mpp_lnk_2d_multiple  *** 
     522      !! 
     523      !! ** Purpose :   Message passing management for multiple 2d arrays 
     524      !! 
     525      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
     526      !!      between processors following neighboring subdomains. 
     527      !!            domain parameters 
     528      !!                    nlci   : first dimension of the local subdomain 
     529      !!                    nlcj   : second dimension of the local subdomain 
     530      !!                    nbondi : mark for "east-west local boundary" 
     531      !!                    nbondj : mark for "north-south local boundary" 
     532      !!                    noea   : number for local neighboring processors 
     533      !!                    nowe   : number for local neighboring processors 
     534      !!                    noso   : number for local neighboring processors 
     535      !!                    nono   : number for local neighboring processors 
     536      !! 
     537      !!---------------------------------------------------------------------- 
     538 
     539      INTEGER :: num_fields 
     540      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     541      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
     542      !                                                               ! = T , U , V , F , W and I points 
     543      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
     544      !                                                               ! =  1. , the sign is kept 
     545      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only 
     546      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries) 
     547      !! 
     548      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     549      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
     550      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     551      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     552 
     553      REAL(wp) ::   zland 
     554      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     555      ! 
     556      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
     557      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
     558 
     559      !!---------------------------------------------------------------------- 
     560 
     561      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  & 
     562         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   ) 
     563 
     564      ! 
     565      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
     566      ELSE                         ;   zland = 0.e0      ! zero by default 
     567      ENDIF 
     568 
     569      ! 1. standard boundary treatment 
     570      ! ------------------------------ 
     571      ! 
     572      !First Array 
     573      DO ii = 1 , num_fields 
     574         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
     575            ! 
     576            ! WARNING pt2d is defined only between nld and nle 
     577            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
     578               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej) 
     579               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej) 
     580               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej)  
     581            END DO 
     582            DO ji = nlci+1, jpi                 ! added column(s) (full) 
     583               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej) 
     584               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     ) 
     585               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej) 
     586            END DO 
     587            ! 
     588         ELSE                              ! standard close or cyclic treatment 
     589            ! 
     590            !                                   ! East-West boundaries 
     591            IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
     592               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     593               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west 
     594               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east 
     595            ELSE                                     ! closed 
     596               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point 
     597                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north 
     598            ENDIF 
     599            !                                   ! North-South boundaries (always closed) 
     600               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point 
     601                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north 
     602            ! 
     603         ENDIF 
     604      END DO 
     605 
     606      ! 2. East and west directions exchange 
     607      ! ------------------------------------ 
     608      ! we play with the neigbours AND the row number because of the periodicity 
     609      ! 
     610      DO ii = 1 , num_fields 
     611         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     612         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     613            iihom = nlci-nreci 
     614            DO jl = 1, jpreci 
     615               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : ) 
     616               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : ) 
     617            END DO 
     618         END SELECT 
     619      END DO 
     620      ! 
     621      !                           ! Migrations 
     622      imigr = jpreci * jpj 
     623      ! 
     624      SELECT CASE ( nbondi ) 
     625      CASE ( -1 ) 
     626         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 ) 
     627         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 
     628         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     629      CASE ( 0 ) 
     630         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 
     631         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 ) 
     632         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 
     633         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 
     634         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     635         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     636      CASE ( 1 ) 
     637         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 
     638         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 
     639         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     640      END SELECT 
     641      ! 
     642      !                           ! Write Dirichlet lateral conditions 
     643      iihom = nlci - jpreci 
     644      ! 
     645 
     646      DO ii = 1 , num_fields 
     647         SELECT CASE ( nbondi ) 
     648         CASE ( -1 ) 
     649            DO jl = 1, jpreci 
     650               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 
     651            END DO 
     652         CASE ( 0 ) 
     653            DO jl = 1, jpreci 
     654               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii) 
     655               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 
     656            END DO 
     657         CASE ( 1 ) 
     658            DO jl = 1, jpreci 
     659               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii) 
     660            END DO 
     661         END SELECT 
     662      END DO 
     663       
     664      ! 3. North and south directions 
     665      ! ----------------------------- 
     666      ! always closed : we play only with the neigbours 
     667      ! 
     668      !First Array 
     669      DO ii = 1 , num_fields 
     670         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     671            ijhom = nlcj-nrecj 
     672            DO jl = 1, jprecj 
     673               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl ) 
     674               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl ) 
     675            END DO 
     676         ENDIF 
     677      END DO 
     678      ! 
     679      !                           ! Migrations 
     680      imigr = jprecj * jpi 
     681      ! 
     682      SELECT CASE ( nbondj ) 
     683      CASE ( -1 ) 
     684         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 ) 
     685         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 
     686         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     687      CASE ( 0 ) 
     688         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 
     689         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 ) 
     690         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 
     691         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 
     692         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     693         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     694      CASE ( 1 ) 
     695         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 
     696         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 
     697         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     698      END SELECT 
     699      ! 
     700      !                           ! Write Dirichlet lateral conditions 
     701      ijhom = nlcj - jprecj 
     702      ! 
     703 
     704      DO ii = 1 , num_fields 
     705         !First Array 
     706         SELECT CASE ( nbondj ) 
     707         CASE ( -1 ) 
     708            DO jl = 1, jprecj 
     709               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii ) 
     710            END DO 
     711         CASE ( 0 ) 
     712            DO jl = 1, jprecj 
     713               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii) 
     714               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii ) 
     715            END DO 
     716         CASE ( 1 ) 
     717            DO jl = 1, jprecj 
     718               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii ) 
     719            END DO 
     720         END SELECT 
     721      END DO 
     722       
     723      ! 4. north fold treatment 
     724      ! ----------------------- 
     725      ! 
     726      DO ii = 1 , num_fields 
     727         !First Array 
     728         IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
     729            ! 
     730            SELECT CASE ( jpni ) 
     731            CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp 
     732            CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) )   ! for all northern procs. 
     733            END SELECT 
     734            ! 
     735         ENDIF 
     736         ! 
     737      END DO 
     738       
     739      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
     740      ! 
     741   END SUBROUTINE mpp_lnk_2d_multiple 
     742 
     743    
     744   SUBROUTINE load_array(pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields) 
     745      !!--------------------------------------------------------------------- 
     746      REAL(wp), DIMENSION(jpi,jpj), TARGET   ,   INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied 
     747      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points 
     748      REAL(wp)                    , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary 
     749      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
     750      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points 
     751      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary 
     752      INTEGER                      , INTENT (inout):: num_fields  
     753      !!--------------------------------------------------------------------- 
     754      num_fields=num_fields+1 
     755      pt2d_array(num_fields)%pt2d=>pt2d 
     756      type_array(num_fields)=cd_type 
     757      psgn_array(num_fields)=psgn 
     758   END SUBROUTINE load_array 
     759    
     760    
     761   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
     762      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
     763      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
     764      !!--------------------------------------------------------------------- 
     765      ! Second 2D array on which the boundary condition is applied 
     766      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA     
     767      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
     768      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI  
     769      ! define the nature of ptab array grid-points 
     770      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
     771      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
     772      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
     773      ! =-1 the sign change across the north fold boundary 
     774      REAL(wp)                                      , INTENT(in   ) ::   psgnA     
     775      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
     776      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI    
     777      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     778      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     779      !! 
     780      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array  
     781      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points 
     782      !                                                         ! = T , U , V , F , W and I points 
     783      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary 
     784      INTEGER :: num_fields 
     785      !!--------------------------------------------------------------------- 
     786 
     787      num_fields = 0 
     788 
     789      !! Load the first array 
     790      CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields) 
     791 
     792      !! Look if more arrays are added 
     793      IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 
     794      IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 
     795      IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 
     796      IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 
     797      IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 
     798      IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 
     799      IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 
     800      IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 
     801       
     802      CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval) 
     803   END SUBROUTINE mpp_lnk_2d_9 
    512804 
    513805 
    … …  
    31843476   LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 
    31853477   INTEGER :: ncomm_ice 
     3478   INTEGER, PUBLIC            ::   mpi_comm_opa          ! opa local communicator 
    31863479   !!---------------------------------------------------------------------- 
    31873480CONTAINS 
    … …  
    31923485   END FUNCTION lib_mpp_alloc 
    31933486 
    3194    FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value) 
     3487   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value) 
    31953488      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    31963489      CHARACTER(len=*),DIMENSION(:) ::   ldtxt 
     3490      CHARACTER(len=*) ::   ldname 
    31973491      INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop 
    3198       IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0 
     3492      IF( PRESENT( localComm ) ) mpi_comm_opa = localComm 
     3493      function_value = 0 
    31993494      IF( .FALSE. )   ldtxt(:) = 'never done' 
    3200       CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     3495      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    32013496   END FUNCTION mynode 
    32023497 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    r5500 r5630  
    140140      !!---------------------------------------------------------------------- 
    141141      USE ldftra_oce, ONLY:   aht0 
     142      USE iom 
    142143      ! 
    143144      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    … …  
    150151      CHARACTER (len=15) ::   clexp 
    151152      INTEGER,     POINTER, DIMENSION(:,:)  :: icof 
    152       INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: idata 
     153      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file 
    153154      !!---------------------------------------------------------------------- 
    154155      !                                 
    … …  
    232233         ! Read 2d integer array to specify western boundary increase in the 
    233234         ! ===================== equatorial strip (20N-20S) defined at t-points 
    234           
    235          ALLOCATE( idata(jpidta,jpjdta), STAT=ierror ) 
    236          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_c2d_orca: unable to allocate idata array' ) 
    237235         ! 
    238          CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    239          READ(inum,9101) clexp, iim, ijm 
    240          READ(inum,'(/)') 
    241          ifreq = 40 
    242          il1 = 1 
    243          DO jn = 1, jpidta/ifreq+1 
    244             READ(inum,'(/)') 
    245             il2 = MIN( jpidta, il1+ifreq-1 ) 
    246             READ(inum,9201) ( ii, ji = il1, il2, 5 ) 
    247             READ(inum,'(/)') 
    248             DO jj = jpjdta, 1, -1 
    249                READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
    250             END DO 
    251             il1 = il1 + ifreq 
    252          END DO 
    253  
    254          DO jj = 1, nlcj 
    255             DO ji = 1, nlci 
    256                icof(ji,jj) = idata( mig(ji), mjg(jj) ) 
    257             END DO 
    258          END DO 
    259          DO jj = nlcj+1, jpj 
    260             DO ji = 1, nlci 
    261                icof(ji,jj) = icof(ji,nlcj) 
    262             END DO 
    263          END DO 
    264          DO jj = 1, jpj 
    265             DO ji = nlci+1, jpi 
    266                icof(ji,jj) = icof(nlci,jj) 
    267             END DO 
    268          END DO 
    269  
    270 9101     FORMAT(1x,a15,2i8) 
    271 9201     FORMAT(3x,13(i3,12x)) 
    272 9202     FORMAT(i3,41i3) 
    273           
    274          DEALLOCATE(idata) 
     236         ALLOCATE( ztemp2d(jpi,jpj) ) 
     237         ztemp2d(:,:) = 0. 
     238         CALL iom_open ( 'ahmcoef.nc', inum ) 
     239         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d) 
     240         icof(:,:)  = NINT(ztemp2d(:,:)) 
     241         CALL iom_close( inum ) 
     242         DEALLOCATE(ztemp2d) 
    275243 
    276244         ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator) 
    … …  
    369337      !!---------------------------------------------------------------------- 
    370338      USE ldftra_oce, ONLY:   aht0 
     339      USE iom 
    371340      ! 
    372341      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    … …  
    380349      CHARACTER (len=15) ::   clexp 
    381350      INTEGER,     POINTER, DIMENSION(:,:)  :: icof 
    382       INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: idata 
     351      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file 
    383352      !!---------------------------------------------------------------------- 
    384353      !                                 
    385354      CALL wrk_alloc( jpi   , jpj   , icof  ) 
    386355      !                                 
    387  
    388356      IF(lwp) WRITE(numout,*) 
    389357      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 
    … …  
    464432         ! Read 2d integer array to specify western boundary increase in the 
    465433         ! ===================== equatorial strip (20N-20S) defined at t-points 
    466           
    467          ALLOCATE( idata(jpidta,jpjdta), STAT=ierror ) 
    468          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_c2d_orca_R1: unable to allocate idata array' ) 
    469          ! 
    470          CALL ctl_opn( inum, 'ahmcoef', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   & 
    471             &           1, numout, lwp ) 
    472          REWIND inum 
    473          READ(inum,9101) clexp, iim, ijm 
    474          READ(inum,'(/)') 
    475          ifreq = 40 
    476          il1 = 1 
    477          DO jn = 1, jpidta/ifreq+1 
    478             READ(inum,'(/)') 
    479             il2 = MIN( jpidta, il1+ifreq-1 ) 
    480             READ(inum,9201) ( ii, ji = il1, il2, 5 ) 
    481             READ(inum,'(/)') 
    482             DO jj = jpjdta, 1, -1 
    483                READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
    484             END DO 
    485             il1 = il1 + ifreq 
    486          END DO 
    487  
    488          DO jj = 1, nlcj 
    489             DO ji = 1, nlci 
    490                icof(ji,jj) = idata( mig(ji), mjg(jj) ) 
    491             END DO 
    492          END DO 
    493          DO jj = nlcj+1, jpj 
    494             DO ji = 1, nlci 
    495                icof(ji,jj) = icof(ji,nlcj) 
    496             END DO 
    497          END DO 
    498          DO jj = 1, jpj 
    499             DO ji = nlci+1, jpi 
    500                icof(ji,jj) = icof(nlci,jj) 
    501             END DO 
    502          END DO 
    503  
    504 9101     FORMAT(1x,a15,2i8) 
    505 9201     FORMAT(3x,13(i3,12x)) 
    506 9202     FORMAT(i3,41i3) 
    507           
    508          DEALLOCATE(idata) 
     434         ALLOCATE( ztemp2d(jpi,jpj) ) 
     435         ztemp2d(:,:) = 0. 
     436         CALL iom_open ( 'ahmcoef.nc', inum ) 
     437         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d) 
     438         icof(:,:)  = NINT(ztemp2d(:,:)) 
     439         CALL iom_close( inum ) 
     440         DEALLOCATE(ztemp2d) 
    509441 
    510442         ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r5500 r5630  
    2727      !!---------------------------------------------------------------------- 
    2828      USE ldftra_oce, ONLY :   aht0 
     29      USE iom 
    2930      !! 
    3031      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    … …  
    193194      !!---------------------------------------------------------------------- 
    194195      USE ldftra_oce, ONLY:   aht0 
     196      USE iom 
    195197      !! 
    196198      LOGICAL, INTENT(in) ::   ld_print   ! If true, output arrays on numout 
    … …  
    204206      CHARACTER (len=15) ::   clexp 
    205207      INTEGER , POINTER, DIMENSION(:,:)  :: icof 
    206       INTEGER , POINTER, DIMENSION(:,:)  :: idata 
    207208      REAL(wp), POINTER, DIMENSION(:  )  :: zcoef    
    208209      REAL(wp), POINTER, DIMENSION(:,:)  :: zahm0 
     210      ! 
     211      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ztemp2d  ! temporary array to read ahmcoef file 
    209212      !!---------------------------------------------------------------------- 
    210213      ! 
    211214      CALL wrk_alloc( jpi   , jpj   , icof  ) 
    212       CALL wrk_alloc( jpidta, jpjdta, idata ) 
    213215      CALL wrk_alloc( jpk   ,         zcoef ) 
    214216      CALL wrk_alloc( jpi   , jpj   , zahm0 ) 
    … …  
    221223      ! Read 2d integer array to specify western boundary increase in the 
    222224      ! ===================== equatorial strip (20N-20S) defined at t-points 
    223  
    224       CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    225       READ(inum,9101) clexp, iim, ijm 
    226       READ(inum,'(/)') 
    227       ifreq = 40 
    228       il1 = 1 
    229       DO jn = 1, jpidta/ifreq+1 
    230          READ(inum,'(/)') 
    231          il2 = MIN( jpidta, il1+ifreq-1 ) 
    232          READ(inum,9201) ( ii, ji = il1, il2, 5 ) 
    233          READ(inum,'(/)') 
    234          DO jj = jpjdta, 1, -1 
    235             READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
    236          END DO 
    237          il1 = il1 + ifreq 
    238       END DO 
    239        
    240       DO jj = 1, nlcj 
    241          DO ji = 1, nlci 
    242             icof(ji,jj) = idata( mig(ji), mjg(jj) ) 
    243          END DO 
    244       END DO 
    245       DO jj = nlcj+1, jpj 
    246          DO ji = 1, nlci 
    247             icof(ji,jj) = icof(ji,nlcj) 
    248          END DO 
    249       END DO 
    250       DO jj = 1, jpj 
    251          DO ji = nlci+1, jpi 
    252             icof(ji,jj) = icof(nlci,jj) 
    253          END DO 
    254       END DO 
    255        
    256 9101  FORMAT(1x,a15,2i8) 
    257 9201  FORMAT(3x,13(i3,12x)) 
    258 9202  FORMAT(i3,41i3) 
    259        
     225      ALLOCATE( ztemp2d(jpi,jpj) ) 
     226      ztemp2d(:,:) = 0. 
     227      CALL iom_open ( 'ahmcoef.nc', inum ) 
     228      CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d) 
     229      icof(:,:)  = NINT(ztemp2d(:,:)) 
     230      CALL iom_close( inum ) 
     231      DEALLOCATE(ztemp2d) 
     232 
    260233      ! Set ahm1 and ahm2 
    261234      ! ================= 
    … …  
    455428      ! 
    456429      CALL wrk_dealloc( jpi   , jpj   , icof  ) 
    457       CALL wrk_dealloc( jpidta, jpjdta, idata ) 
    458430      CALL wrk_dealloc( jpk   ,         zcoef ) 
    459431      CALL wrk_dealloc( jpi   , jpj   , zahm0 ) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r5500 r5630  
    1515   !!---------------------------------------------------------------------- 
    1616   !!---------------------------------------------------------------------- 
    17    !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3 
     17   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT 
     18   !!   'key_oa3mct_v3'                 to be added for OASIS3-MCT version 3 
    1819   !!---------------------------------------------------------------------- 
    1920   !!   cpl_init     : initialization of coupled mode communication 
    … …  
    6162#endif 
    6263 
    63    INTEGER, PUBLIC, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields 
     64   INTEGER                    ::   nrcv         ! total number of fields received  
     65   INTEGER                    ::   nsnd         ! total number of fields sent  
     66   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     67   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=50   ! Maximum number of coupling fields 
    6468   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    6569   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    … …  
    8690CONTAINS 
    8791 
    88    SUBROUTINE cpl_init( kl_comm ) 
     92   SUBROUTINE cpl_init( cd_modname, kl_comm ) 
    8993      !!------------------------------------------------------------------- 
    9094      !!             ***  ROUTINE cpl_init  *** 
    … …  
    9599      !! ** Method  :   OASIS3 MPI communication  
    96100      !!-------------------------------------------------------------------- 
    97       INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model 
     101      CHARACTER(len = *), INTENT(in) ::   cd_modname   ! model name as set in namcouple file 
     102      INTEGER          , INTENT(out) ::   kl_comm      ! local communicator of the model 
    98103      !!-------------------------------------------------------------------- 
    99104 
    … …  
    104109      ! 1st Initialize the OASIS system for the application 
    105110      !------------------------------------------------------------------ 
    106       CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 
     111      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 
    107112      IF ( nerror /= OASIS_Ok ) & 
    108113         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
    … …  
    144149      IF(lwp) WRITE(numout,*) 
    145150 
     151      ncplmodel = kcplmodel 
    146152      IF( kcplmodel > nmaxcpl ) THEN 
    147          CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
     153         CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN 
    148154      ENDIF 
     155 
     156      nrcv = krcv 
     157      IF( nrcv > nmaxfld ) THEN 
     158         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld')   ;   RETURN 
     159      ENDIF 
     160 
     161      nsnd = ksnd 
     162      IF( nsnd > nmaxfld ) THEN 
     163         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN 
     164      ENDIF 
     165 
    149166      ! 
    150167      ! ... Define the shape for the area that excludes the halo 
    … …  
    400417 
    401418 
    402    INTEGER FUNCTION cpl_freq( kid )   
     419   INTEGER FUNCTION cpl_freq( cdfieldname )   
    403420      !!--------------------------------------------------------------------- 
    404421      !!              ***  ROUTINE cpl_freq  *** 
    … …  
    406423      !! ** Purpose : - send back the coupling frequency for a particular field 
    407424      !!---------------------------------------------------------------------- 
    408       INTEGER,INTENT(in) ::   kid   ! variable index 
    409       !! 
     425      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file 
     426      !! 
     427      INTEGER               :: id 
    410428      INTEGER               :: info 
    411429      INTEGER, DIMENSION(1) :: itmp 
     430      INTEGER               :: ji,jm     ! local loop index 
     431      INTEGER               :: mop 
    412432      !!---------------------------------------------------------------------- 
    413       CALL oasis_get_freqs(kid, 1, itmp, info) 
    414       cpl_freq = itmp(1) 
     433      cpl_freq = 0   ! defaut definition 
     434      id = -1        ! defaut definition 
     435      ! 
     436      DO ji = 1, nsnd 
     437         IF (ssnd(ji)%laction ) THEN 
     438            DO jm = 1, ncplmodel 
     439               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 
     440                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN 
     441                     id = ssnd(ji)%nid(1,jm) 
     442                     mop = OASIS_Out 
     443                  ENDIF 
     444               ENDIF 
     445            ENDDO 
     446         ENDIF 
     447      ENDDO 
     448      DO ji = 1, nrcv 
     449         IF (srcv(ji)%laction ) THEN 
     450            DO jm = 1, ncplmodel 
     451               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 
     452                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN 
     453                     id = srcv(ji)%nid(1,jm) 
     454                     mop = OASIS_In 
     455                  ENDIF 
     456               ENDIF 
     457            ENDDO 
     458         ENDIF 
     459      ENDDO 
     460      ! 
     461      IF( id /= -1 ) THEN 
     462#if defined key_oa3mct_v3 
     463         CALL oasis_get_freqs(id, mop, 1, itmp, info) 
     464#else 
     465         CALL oasis_get_freqs(id,      1, itmp, info) 
     466#endif 
     467         cpl_freq = itmp(1) 
     468      ENDIF 
    415469      ! 
    416470   END FUNCTION cpl_freq 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r5500 r5630  
    154154      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1 
    155155 
    156       it_offset = 0 
     156      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     157      ELSE                                      ;   it_offset = 0 
     158      ENDIF 
    157159      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    158160 
    … …  
    452454      ENDIF 
    453455      ! 
    454       it_offset = 0 
     456      IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     457      ELSE                                      ;   it_offset = 0 
     458      ENDIF 
    455459      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    456460      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 
    … …  
    10211025      INTEGER                           ::   ipk           ! temporary vertical dimension 
    10221026      CHARACTER (len=5)                 ::   aname 
    1023       INTEGER , DIMENSION(3)            ::   ddims 
     1027      INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims 
    10241028      INTEGER , POINTER, DIMENSION(:,:) ::   data_src 
    10251029      REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp 
    … …  
    10441048 
    10451049      !! get dimensions 
     1050      IF ( SIZE(sd%fnow, 3) > 1 ) THEN 
     1051         ALLOCATE( ddims(4) ) 
     1052      ELSE 
     1053         ALLOCATE( ddims(3) ) 
     1054      ENDIF 
    10461055      id = iom_varid( inum, sd%clvar, ddims ) 
    10471056 
    … …  
    11401149         CALL ctl_stop( '    fld_weight : unable to read the file ' ) 
    11411150      ENDIF 
     1151 
     1152      DEALLOCATE (ddims ) 
    11421153 
    11431154      CALL wrk_dealloc( jpi,jpj, data_src )   ! integer 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r5500 r5630  
    5858   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2] 
    5959   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice        !: solar heat flux over ice                      [W/m2] 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean   !: daily mean solar heat flux over ice           [W/m2] 
    6160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2] 
    6261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K] 
    … …  
    6968   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-] 
    7069   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-] 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2] 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice          [kg/m2/s] 
    7271 
    7372   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
    7473   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
     74 
     75#if defined  key_lim3 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   evap_ice       !: sublimation                              [kg/m2/s] 
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   devap_ice      !: sublimation sensitivity                [kg/m2/s/K] 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qns_oce        !: non solar heat flux over ocean              [W/m2] 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsr_oce        !: non solar heat flux over ocean              [W/m2] 
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_oce       !: heat flux of precip and evap over ocean     [W/m2] 
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat flux of precip and evap over ice       [W/m2] 
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: heat flux of precip over ice                [J/m3] 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
     84#endif 
     85#if defined key_lim3 || defined key_lim2 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s] 
     87#endif 
    7588 
    7689#if defined key_cice 
    … …  
    100113#endif 
    101114 
    102 #if defined key_lim3 || defined key_cice 
    103    ! not used with LIM2 
     115#if defined key_cice 
    104116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    105117#endif 
    … …  
    125137      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
    126138         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
    127          &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) ,     & 
    128          &      alb_ice (jpi,jpj,jpl) ,                             & 
    129          &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     ,     & 
     139         &      dqns_ice(jpi,jpj,jpl) , tn_ice  (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) ,   & 
     140         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   & 
    130141         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    131 #if defined key_lim3 
    132          &      tatm_ice(jpi,jpj)     ,                             & 
    133 #endif 
    134142#if defined key_lim2 
    135143         &      a_i(jpi,jpj,jpl)      ,                             & 
     144#endif 
     145#if defined key_lim3 
     146         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,  & 
     147         &      qemp_ice(jpi,jpj)     , qemp_oce(jpi,jpj)      ,                       & 
     148         &      qns_oce (jpi,jpj)     , qsr_oce (jpi,jpj)      , emp_oce (jpi,jpj)  ,  & 
    136149#endif 
    137150         &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) ) 
    … …  
    145158                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
    146159                STAT= ierr(1) ) 
    147       IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     160      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
    148161         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
    149162         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
    … …  
    152165#endif 
    153166         ! 
    154 #if defined key_lim2 
    155       IF( ltrcdm2dc_ice )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 
    156 #endif 
    157          ! 
    158167#if defined key_cice || defined key_lim2 
    159       IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     168      IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
    160169#endif 
    161170 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5500 r5630  
    3636   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
    3737#if defined key_oasis3 
    38    LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation 
     38   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
    3939#else 
    40    LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation 
    41 #endif 
     40   LOGICAL , PUBLIC ::   lk_oasis = .FALSE. !: OASIS unused 
     41#endif 
     42   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation 
     43   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation 
    4244   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr) 
    4345   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths 
    … …  
    5052   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
    5153   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    52    INTEGER , PUBLIC :: nn_limflx        !: LIM3 Multi-category heat flux formulation 
     54   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below)  
     55   INTEGER , PUBLIC ::   nn_limflx      !: LIM3 Multi-category heat flux formulation 
    5356   !                                             !: =-1  Use of per-category fluxes 
    5457   !                                             !: = 0  Average per-category fluxes 
    … …  
    6972   !!           switch definition (improve readability) 
    7073   !!---------------------------------------------------------------------- 
    71    INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation 
    72    INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation 
    73    INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation 
    74    INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation 
    75    INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation 
    76    INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation 
    77    INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation 
     74   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical               formulation 
     75   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical                    formulation 
     76   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk                     formulation 
     78   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk                     formulation 
     79   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation 
     80   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk                     formulation 
     81   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 7        !: for OPA when doing coupling via SAS module 
    7882   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations 
    7983    
    8084   !!---------------------------------------------------------------------- 
     85   !!           component definition 
     86   !!---------------------------------------------------------------------- 
     87   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration  
     88                                                         !  (no internal OASIS coupling) 
     89   INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component 
     90                                                         !  (internal OASIS coupling) 
     91   INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component 
     92                                                         !  (internal OASIS coupling) 
     93   !!---------------------------------------------------------------------- 
    8194   !!              Ocean Surface Boundary Condition fields 
    8295   !!---------------------------------------------------------------------- 
     96   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere 
     97   ! 
    8398   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress) 
    84    LOGICAL , PUBLIC ::   ltrcdm2dc               !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux 
    8599   !!                                   !!   now    ! before   !! 
    86100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2] 
    … …  
    90104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
    91105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2] 
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_mean          !: daily mean sea heat flux: solar              [W/m2] 
    93106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
    94107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2] 
    … …  
    111124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
    112125#endif 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
    113127 
    114128   !!---------------------------------------------------------------------- 
    … …  
    122136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m] 
    123137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m] 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 
    124139 
    125140   !! * Substitutions 
    … …  
    155170         &      atm_co2(jpi,jpj) ,                                        & 
    156171#endif 
    157          &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) ,                       & 
    158          &      ssv_m  (jpi,jpj) , sss_m  (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) ) 
     172         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      & 
     173         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 
    159174         ! 
    160175#if defined key_vvl 
    161176      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 
    162177#endif 
    163          ! 
    164       IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) ) 
    165178         ! 
    166179      sbc_oce_alloc = MAXVAL( ierr ) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r5500 r5630  
    3434   USE albedo 
    3535   USE prtctl          ! Print control 
    36 #if defined key_lim3 
     36#if defined key_lim3  
    3737   USE ice 
    3838   USE sbc_ice         ! Surface boundary condition: ice fields 
     39   USE limthd_dh       ! for CALL lim_thd_snwblow 
    3940#elif defined key_lim2 
    4041   USE ice_2 
     42   USE sbc_ice         ! Surface boundary condition: ice fields 
     43   USE par_ice_2       ! Surface boundary condition: ice fields 
    4144#endif 
    4245 
    … …  
    4548 
    4649   PUBLIC sbc_blk_clio        ! routine called by sbcmod.F90  
    47    PUBLIC blk_ice_clio        ! routine called by sbcice_lim.F90  
     50#if defined key_lim2 || defined key_lim3 
     51   PUBLIC blk_ice_clio_tau    ! routine called by sbcice_lim.F90  
     52   PUBLIC blk_ice_clio_flx    ! routine called by sbcice_lim.F90  
     53#endif 
    4854 
    4955   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read  
    … …  
    378384         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius 
    379385      qns(:,:) = qns(:,:) * tmask(:,:,1) 
     386#if defined key_lim3 
     387      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 
     388      qsr_oce(:,:) = qsr(:,:) 
     389#endif 
    380390      ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 
    381391 
    382       CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean 
    383       CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean 
    384       CALL iom_put( "qla_oce", - zqla )   ! output downward latent    heat over the ocean 
    385       CALL iom_put( "qns_oce",   qns  )   ! output downward non solar heat over the ocean 
     392      IF ( nn_ice == 0 ) THEN 
     393         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave  heat over the ocean 
     394         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible  heat over the ocean 
     395         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent    heat over the ocean 
     396         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
     397         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
     398         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
     399         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
     400      ENDIF 
    386401 
    387402      IF(ln_ctl) THEN 
    … …  
    399414   END SUBROUTINE blk_oce_clio 
    400415 
    401  
    402    SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os, palb,  & 
    403       &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    404       &                      p_qla , p_dqns, p_dqla,          & 
    405       &                      p_tpr , p_spr ,                  & 
    406       &                      p_fr1 , p_fr2 , cd_grid, pdim  ) 
     416# if defined key_lim2 || defined key_lim3 
     417   SUBROUTINE blk_ice_clio_tau 
    407418      !!--------------------------------------------------------------------------- 
    408       !!                     ***  ROUTINE blk_ice_clio  *** 
     419      !!                     ***  ROUTINE blk_ice_clio_tau  *** 
     420      !!                  
     421      !!  ** Purpose :   Computation momentum flux at the ice-atm interface   
     422      !!          
     423      !!  ** Method  :   Read utau from a forcing file. Rearrange if C-grid 
     424      !! 
     425      !!---------------------------------------------------------------------- 
     426      REAL(wp) ::   zcoef 
     427      INTEGER  ::   ji, jj   ! dummy loop indices 
     428      !!--------------------------------------------------------------------- 
     429      ! 
     430      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_tau') 
     431 
     432      SELECT CASE( cp_ice_msh ) 
     433 
     434      CASE( 'C' )                          ! C-grid ice dynamics 
     435 
     436         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress 
     437         utau_ice(:,:) = zcoef * utau(:,:) 
     438         vtau_ice(:,:) = zcoef * vtau(:,:) 
     439 
     440      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner) 
     441 
     442         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress 
     443         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point 
     444            DO ji = 2, jpi   ! I-grid : no vector opt. 
     445               utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) ) 
     446               vtau_ice(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) ) 
     447            END DO 
     448         END DO 
     449 
     450         CALL lbc_lnk( utau_ice(:,:), 'I', -1. )   ;   CALL lbc_lnk( vtau_ice(:,:), 'I', -1. )   ! I-point 
     451 
     452      END SELECT 
     453 
     454      IF(ln_ctl) THEN 
     455         CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 
     456      ENDIF 
     457 
     458      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_tau') 
     459 
     460   END SUBROUTINE blk_ice_clio_tau 
     461#endif 
     462 
     463# if defined key_lim2 || defined key_lim3 
     464   SUBROUTINE blk_ice_clio_flx(  ptsu , palb_cs, palb_os, palb ) 
     465      !!--------------------------------------------------------------------------- 
     466      !!                     ***  ROUTINE blk_ice_clio_flx *** 
    409467      !!                  
    410468      !!  ** Purpose :   Computation of the heat fluxes at ocean and snow/ice 
    … …  
    428486      !!                         to take into account solid precip latent heat flux 
    429487      !!---------------------------------------------------------------------- 
    430       REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
     488      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   ptsu      ! ice surface temperature                   [Kelvin] 
    431489      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [-] 
    432490      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [-] 
    433491      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   palb     ! ice albedo (actual value)                      [-] 
    434       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2] 
    435       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2] 
    436       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qns    ! non solar heat flux over ice (T-point)      [W/m2] 
    437       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qsr    !     solar heat flux over ice (T-point)      [W/m2] 
    438       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qla    ! latent    heat flux over ice (T-point)      [W/m2] 
    439       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqns   ! non solar heat sensistivity  (T-point)      [W/m2] 
    440       REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqla   ! latent    heat sensistivity  (T-point)      [W/m2] 
    441       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s] 
    442       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s] 
    443       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [-] 
    444       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [-] 
    445       CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid) 
    446       INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories 
    447492      !! 
    448493      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    449       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    450       !! 
    451       REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3     ! temporary scalars 
     494      !! 
     495      REAL(wp) ::   zmt1, zmt2, zmt3, ztatm3                    ! temporary scalars 
    452496      REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         - 
    453497      REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         - 
    … …  
    455499      REAL(wp) ::   zcshi, zclei, zrhovaclei, zrhovacshi        !    -         - 
    456500      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
     501      REAL(wp) ::   z1_lsub                                     !    -         - 
    457502      !! 
    458503      REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin 
    … …  
    461506      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density 
    462507      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
     508      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw 
    463509      !!--------------------------------------------------------------------- 
    464510      ! 
    465       IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio') 
     511      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio_flx') 
    466512      ! 
    467513      CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
    468       CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    469  
    470       ijpl  = pdim                           ! number of ice categories 
     514      CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 
     515 
    471516      zpatm = 101000.                        ! atmospheric pressure  (assumed constant  here) 
    472  
    473 #if defined key_lim3       
    474       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 
    475 #endif 
    476       !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
    477       !------------------------------------! 
    478       !   momentum fluxes  (utau, vtau )   ! 
    479       !------------------------------------! 
    480  
    481       SELECT CASE( cd_grid ) 
    482       CASE( 'C' )                          ! C-grid ice dynamics 
    483          zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress 
    484          p_taui(:,:) = zcoef * utau(:,:) 
    485          p_tauj(:,:) = zcoef * vtau(:,:) 
    486       CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner) 
    487          zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress 
    488          DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point 
    489             DO ji = 2, jpi   ! I-grid : no vector opt. 
    490                p_taui(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) ) 
    491                p_tauj(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) ) 
    492             END DO 
    493          END DO 
    494          CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point 
    495       END SELECT 
    496  
    497  
     517      !-------------------------------------------------------------------------------- 
    498518      !  Determine cloud optical depths as a function of latitude (Chou et al., 1981). 
    499519      !  and the correction factor for taking into account  the effect of clouds  
    500       !------------------------------------------------------ 
     520      !-------------------------------------------------------------------------------- 
     521 
    501522!CDIR NOVERRCHK 
    502523!CDIR COLLAPSE 
    … …  
    525546            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 
    526547            zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 
    527             p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
     548            sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
    528549               &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s] 
    529550               &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   & 
    … …  
    535556            ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 
    536557            ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    537             p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)  
    538             p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 
    539          END DO 
    540       END DO 
    541       CALL iom_put( 'snowpre', p_spr )   ! Snow precipitation  
     558            fr1_i0(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)  
     559            fr2_i0(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 
     560         END DO 
     561      END DO 
     562      CALL iom_put( 'snowpre', sprecip )   ! Snow precipitation  
    542563       
    543564      !-----------------------------------------------------------! 
    544565      !  snow/ice Shortwave radiation   (abedo already computed)  ! 
    545566      !-----------------------------------------------------------! 
    546       CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 
    547        
    548       DO jl = 1, ijpl 
     567      CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 
     568       
     569      DO jl = 1, jpl 
    549570         palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) )   & 
    550571            &         +   palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) 
    … …  
    552573 
    553574      !                                     ! ========================== ! 
    554       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     575      DO jl = 1, jpl                       !  Loop over ice categories  ! 
    555576         !                                  ! ========================== ! 
    556577!CDIR NOVERRCHK 
    … …  
    566587               ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) )  
    567588               ! 
    568                z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) )  
     589               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) )  
    569590 
    570591               !---------------------------------------- 
    … …  
    573594 
    574595               ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 
    575                zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) ) 
     596               zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) ) 
    576597               ! humidity close to the ice surface (at saturation) 
    577598               zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 
    578599                
    579600               !  computation of intermediate values 
    580                zticemb  = pst(ji,jj,jl) - 7.66 
     601               zticemb  = ptsu(ji,jj,jl) - 7.66 
    581602               zticemb2 = zticemb * zticemb   
    582                ztice3   = pst(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl) 
     603               ztice3   = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 
    583604               zdesidt  = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 ) 
    584605                
    … …  
    593614             
    594615               !  sensible heat flux 
    595                z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) ) 
     616               z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 
    596617             
    597618               !  latent heat flux  
    598                p_qla(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  ) 
     619               qla_ice(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  ) 
    599620               
    600621               !  sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) 
    … …  
    603624               zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )    
    604625               ! 
    605                p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
    606                p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
     626               dqla_ice(ji,jj,jl) = zdqla                           ! latent flux sensitivity 
     627               dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity 
    607628            END DO 
    608629            ! 
    … …  
    616637      ! 
    617638!CDIR COLLAPSE 
    618       p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    619 !CDIR COLLAPSE 
    620       p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
     639      qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:)      ! Downward Non Solar flux 
     640!CDIR COLLAPSE 
     641      tprecip(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
    621642      ! 
    622643      ! ----------------------------------------------------------------------------- ! 
    … …  
    625646!CDIR COLLAPSE 
    626647      qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with: 
    627          &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip 
    628          &     + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting 
    629          &     - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair 
    630       ! 
     648         &     - sprecip(:,:) * lfus                                                  &   ! remove melting solid precip 
     649         &     + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting 
     650         &     - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair 
     651 
     652#if defined key_lim3 
     653      ! ----------------------------------------------------------------------------- ! 
     654      !    Distribute evapo, precip & associated heat over ice and ocean 
     655      ! ---------------=====--------------------------------------------------------- ! 
     656      CALL wrk_alloc( jpi,jpj, zevap, zsnw )  
     657 
     658      ! --- evaporation --- ! 
     659      z1_lsub = 1._wp / Lsub 
     660      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 
     661      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 
     662      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean 
     663 
     664      ! --- evaporation minus precipitation --- ! 
     665      zsnw(:,:) = 0._wp 
     666      CALL lim_thd_snwblow( pfrld, zsnw )          ! snow redistribution by wind 
     667      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 
     668      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
     669      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
     670 
     671      ! --- heat flux associated with emp --- ! 
     672      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap 
     673         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip 
     674         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip 
     675         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     676      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
     677         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     678 
     679      ! --- total solar and non solar fluxes --- ! 
     680      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
     681      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     682 
     683      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     684      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     685 
     686      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )  
     687#endif 
     688 
    631689!!gm : not necessary as all input data are lbc_lnk... 
    632       CALL lbc_lnk( p_fr1  (:,:) , 'T', 1. ) 
    633       CALL lbc_lnk( p_fr2  (:,:) , 'T', 1. ) 
    634       DO jl = 1, ijpl 
    635          CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. ) 
    636          CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. ) 
    637          CALL lbc_lnk( p_qla (:,:,jl) , 'T', 1. ) 
    638          CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. ) 
     690      CALL lbc_lnk( fr1_i0  (:,:) , 'T', 1. ) 
     691      CALL lbc_lnk( fr2_i0  (:,:) , 'T', 1. ) 
     692      DO jl = 1, jpl 
     693         CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. ) 
     694         CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. ) 
     695         CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. ) 
     696         CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. ) 
    639697      END DO 
    640698 
    641699!!gm : mask is not required on forcing 
    642       DO jl = 1, ijpl 
    643          p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 
    644          p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 
    645          p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1) 
    646          p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1) 
    647       END DO 
     700      DO jl = 1, jpl 
     701         qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1) 
     702         qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1) 
     703         dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1) 
     704         dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1) 
     705      END DO 
     706 
     707      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
     708      CALL wrk_dealloc( jpi,jpj, jpl  , z_qlw, z_qsb ) 
    648709 
    649710      IF(ln_ctl) THEN 
    650          CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=ijpl) 
    651          CALL prt_ctl(tab3d_1=p_qla  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=p_qsr  , clinfo2=' p_qsr  : ', kdim=ijpl) 
    652          CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns  , clinfo2=' p_qns  : ', kdim=ijpl) 
    653          CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst    , clinfo2=' pst    : ', kdim=ijpl) 
    654          CALL prt_ctl(tab2d_1=p_tpr  , clinfo1=' blk_ice_clio: p_tpr  : ', tab2d_2=p_spr  , clinfo2=' p_spr  : ') 
    655          CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 
     711         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=jpl) 
     712         CALL prt_ctl(tab3d_1=qla_ice  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=qsr_ice  , clinfo2=' qsr_ice  : ', kdim=jpl) 
     713         CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice  , clinfo2=' qns_ice  : ', kdim=jpl) 
     714         CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu    , clinfo2=' ptsu    : ', kdim=jpl) 
     715         CALL prt_ctl(tab2d_1=tprecip  , clinfo1=' blk_ice_clio: tprecip  : ', tab2d_2=sprecip  , clinfo2=' sprecip  : ') 
    656716      ENDIF 
    657717 
    658       CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 
    659       CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 
    660       ! 
    661       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio') 
    662       ! 
    663    END SUBROUTINE blk_ice_clio 
    664  
     718      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio_flx') 
     719      ! 
     720   END SUBROUTINE blk_ice_clio_flx 
     721 
     722#endif 
    665723 
    666724   SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r5500 r5630  
    2222   !!   blk_oce_core    : computes momentum, heat and freshwater fluxes over ocean 
    2323   !!   blk_ice_core    : computes momentum, heat and freshwater fluxes over ice 
    24    !!   blk_bio_meanqsr : compute daily mean short wave radiation over the ocean 
    25    !!   blk_ice_meanqsr : compute daily mean short wave radiation over the ice 
    2624   !!   turb_core_2z    : Computes turbulent transfert coefficients 
    2725   !!   cd_neutral_10m  : Estimate of the neutral drag coefficient at 10m 
    … …  
    4644   USE sbc_ice         ! Surface boundary condition: ice fields 
    4745   USE lib_fortran     ! to use key_nosignedzero 
     46#if defined key_lim3 
     47   USE ice, ONLY       : u_ice, v_ice, jpl, pfrld, a_i_b 
     48   USE limthd_dh       ! for CALL lim_thd_snwblow 
     49#elif defined key_lim2 
     50   USE ice_2, ONLY     : u_ice, v_ice 
     51   USE par_ice_2 
     52#endif 
    4853 
    4954   IMPLICIT NONE 
    … …  
    5156 
    5257   PUBLIC   sbc_blk_core         ! routine called in sbcmod module 
    53    PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module 
    54    PUBLIC   blk_ice_meanqsr      ! routine called in sbc_ice_lim module 
     58#if defined key_lim2 || defined key_lim3 
     59   PUBLIC   blk_ice_core_tau     ! routine called in sbc_ice_lim module 
     60   PUBLIC   blk_ice_core_flx     ! routine called in sbc_ice_lim module 
     61#endif 
    5562   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    5663 
    … …  
    195202      !                                            ! compute the surface ocean fluxes using CORE bulk formulea 
    196203      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 
    197  
    198       ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery 
    199       IF( ltrcdm2dc )   CALL blk_bio_meanqsr 
    200204 
    201205#if defined key_cice 
    … …  
    302306      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    303307      ENDIF 
     308 
    304309      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    305310      ! ----------------------------------------------------------------------------- ! 
    … …  
    376381      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    377382         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    378       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar flux 
     383      ! 
     384      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar  
    379385         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
    380386         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
    … …  
    384390         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 
    385391      ! 
    386       CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean 
    387       CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean 
    388       CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean 
    389       CALL iom_put( "qhc_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
    390       CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean 
     392#if defined key_lim3 
     393      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3) 
     394      qsr_oce(:,:) = qsr(:,:) 
     395#endif 
     396      ! 
     397      IF ( nn_ice == 0 ) THEN 
     398         CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean 
     399         CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean 
     400         CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean 
     401         CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
     402         CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
     403         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
     404         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
     405      ENDIF 
    391406      ! 
    392407      IF(ln_ctl) THEN 
    … …  
    406421  
    407422    
    408    SUBROUTINE blk_ice_core(  pst   , pui   , pvi   , palb ,   & 
    409       &                      p_taui, p_tauj, p_qns , p_qsr,   & 
    410       &                      p_qla , p_dqns, p_dqla,          & 
    411       &                      p_tpr , p_spr ,                  & 
    412       &                      p_fr1 , p_fr2 , cd_grid, pdim  )  
    413       !!--------------------------------------------------------------------- 
    414       !!                     ***  ROUTINE blk_ice_core  *** 
     423#if defined key_lim2 || defined key_lim3 
     424   SUBROUTINE blk_ice_core_tau 
     425      !!--------------------------------------------------------------------- 
     426      !!                     ***  ROUTINE blk_ice_core_tau  *** 
    415427      !! 
    416428      !! ** Purpose :   provide the surface boundary condition over sea-ice 
    417429      !! 
    418       !! ** Method  :   compute momentum, heat and freshwater exchanged 
    419       !!                between atmosphere and sea-ice using CORE bulk 
    420       !!                formulea, ice variables and read atmmospheric fields. 
     430      !! ** Method  :   compute momentum using CORE bulk 
     431      !!                formulea, ice variables and read atmospheric fields. 
    421432      !!                NB: ice drag coefficient is assumed to be a constant 
    422       !!  
    423       !! caution : the net upward water flux has with mm/day unit 
    424       !!--------------------------------------------------------------------- 
    425       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin] 
    426       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    427       REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    428       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (all skies)                            [%] 
    429       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    430       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
    431       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2] 
    432       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2] 
    433       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2] 
    434       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2] 
    435       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2] 
    436       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s] 
    437       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s] 
    438       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%] 
    439       REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%] 
    440       CHARACTER(len=1)          , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid) 
    441       INTEGER                   , INTENT(in   ) ::   pdim     ! number of ice categories 
    442       !! 
    443       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    444       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    445       REAL(wp) ::   zst2, zst3 
    446       REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
    447       REAL(wp) ::   zztmp                                        ! temporary variable 
    448       REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
    449       REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    450       !! 
    451       REAL(wp), DIMENSION(:,:)  , POINTER ::   z_wnds_t          ! wind speed ( = | U10m - U_ice | ) at T-point 
    452       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
    453       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
    454       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
    455       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
    456       !!--------------------------------------------------------------------- 
    457       ! 
    458       IF( nn_timing == 1 )  CALL timing_start('blk_ice_core') 
    459       ! 
    460       CALL wrk_alloc( jpi,jpj, z_wnds_t ) 
    461       CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb )  
    462  
    463       ijpl  = pdim                            ! number of ice categories 
    464  
     433      !!--------------------------------------------------------------------- 
     434      INTEGER  ::   ji, jj    ! dummy loop indices 
     435      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2 
     436      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f               ! relative wind module and components at F-point 
     437      REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point 
     438      !!--------------------------------------------------------------------- 
     439      ! 
     440      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_tau') 
     441      ! 
    465442      ! local scalars ( place there for vector optimisation purposes) 
    466443      zcoef_wnorm  = rhoa * Cice 
    467444      zcoef_wnorm2 = rhoa * Cice * 0.5 
    468       zcoef_dqlw   = 4.0 * 0.95 * Stef 
    469       zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
    470       zcoef_dqsb   = rhoa * cpa * Cice 
    471445 
    472446!!gm brutal.... 
    473       z_wnds_t(:,:) = 0.e0 
    474       p_taui  (:,:) = 0.e0 
    475       p_tauj  (:,:) = 0.e0 
     447      utau_ice  (:,:) = 0._wp 
     448      vtau_ice  (:,:) = 0._wp 
     449      wndm_ice  (:,:) = 0._wp 
    476450!!gm end 
    477451 
    478 #if defined key_lim3 
    479       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 
    480 #endif 
    481452      ! ----------------------------------------------------------------------------- ! 
    482453      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   ! 
    483454      ! ----------------------------------------------------------------------------- ! 
    484       SELECT CASE( cd_grid ) 
     455      SELECT CASE( cp_ice_msh ) 
    485456      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
    486457         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
    … …  
    489460               ! ... scalar wind at I-point (fld being at T-point) 
    490461               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
    491                   &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pui(ji,jj) 
     462                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj) 
    492463               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
    493                   &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pvi(ji,jj) 
     464                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj) 
    494465               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    495466               ! ... ice stress at I-point 
    496                p_taui(ji,jj) = zwnorm_f * zwndi_f 
    497                p_tauj(ji,jj) = zwnorm_f * zwndj_f 
     467               utau_ice(ji,jj) = zwnorm_f * zwndi_f 
     468               vtau_ice(ji,jj) = zwnorm_f * zwndj_f 
    498469               ! ... scalar wind at T-point (fld being at T-point) 
    499                zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
    500                   &                                                    + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
    501                zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
    502                   &                                                    + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
    503                z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     470               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   & 
     471                  &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  ) 
     472               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   & 
     473                  &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  ) 
     474               wndm_ice(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    504475            END DO 
    505476         END DO 
    506          CALL lbc_lnk( p_taui  , 'I', -1. ) 
    507          CALL lbc_lnk( p_tauj  , 'I', -1. ) 
    508          CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
     477         CALL lbc_lnk( utau_ice, 'I', -1. ) 
     478         CALL lbc_lnk( vtau_ice, 'I', -1. ) 
     479         CALL lbc_lnk( wndm_ice, 'T',  1. ) 
    509480         ! 
    510481      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    511482         DO jj = 2, jpj 
    512483            DO ji = fs_2, jpi   ! vect. opt. 
    513                zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
    514                zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
    515                z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     484               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
     485               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
     486               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    516487            END DO 
    517488         END DO 
    518489         DO jj = 2, jpjm1 
    519490            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    520                p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          & 
    521                   &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) ) 
    522                p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          & 
    523                   &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) ) 
     491               utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          & 
     492                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 
     493               vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          & 
     494                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 
    524495            END DO 
    525496         END DO 
    526          CALL lbc_lnk( p_taui  , 'U', -1. ) 
    527          CALL lbc_lnk( p_tauj  , 'V', -1. ) 
    528          CALL lbc_lnk( z_wnds_t, 'T',  1. ) 
     497         CALL lbc_lnk( utau_ice, 'U', -1. ) 
     498         CALL lbc_lnk( vtau_ice, 'V', -1. ) 
     499         CALL lbc_lnk( wndm_ice, 'T',  1. ) 
    529500         ! 
    530501      END SELECT 
     502 
     503      IF(ln_ctl) THEN 
     504         CALL prt_ctl(tab2d_1=utau_ice  , clinfo1=' blk_ice_core: utau_ice : ', tab2d_2=vtau_ice  , clinfo2=' vtau_ice : ') 
     505         CALL prt_ctl(tab2d_1=wndm_ice  , clinfo1=' blk_ice_core: wndm_ice : ') 
     506      ENDIF 
     507 
     508      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_tau') 
     509       
     510   END SUBROUTINE blk_ice_core_tau 
     511 
     512 
     513   SUBROUTINE blk_ice_core_flx( ptsu, palb ) 
     514      !!--------------------------------------------------------------------- 
     515      !!                     ***  ROUTINE blk_ice_core_flx  *** 
     516      !! 
     517      !! ** Purpose :   provide the surface boundary condition over sea-ice 
     518      !! 
     519      !! ** Method  :   compute heat and freshwater exchanged 
     520      !!                between atmosphere and sea-ice using CORE bulk 
     521      !!                formulea, ice variables and read atmmospheric fields. 
     522      !!  
     523      !! caution : the net upward water flux has with mm/day unit 
     524      !!--------------------------------------------------------------------- 
     525      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu          ! sea ice surface temperature 
     526      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb          ! ice albedo (all skies) 
     527      !! 
     528      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     529      REAL(wp) ::   zst2, zst3 
     530      REAL(wp) ::   zcoef_dqlw, zcoef_dqla, zcoef_dqsb 
     531      REAL(wp) ::   zztmp, z1_lsub                               ! temporary variable 
     532      !! 
     533      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
     534      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
     535      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
     536      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
     537      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw       ! evaporation and snw distribution after wind blowing (LIM3) 
     538      !!--------------------------------------------------------------------- 
     539      ! 
     540      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core_flx') 
     541      ! 
     542      CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb )  
     543 
     544      ! local scalars ( place there for vector optimisation purposes) 
     545      zcoef_dqlw   = 4.0 * 0.95 * Stef 
     546      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
     547      zcoef_dqsb   = rhoa * cpa * Cice 
    531548 
    532549      zztmp = 1. / ( 1. - albo ) 
    533550      !                                     ! ========================== ! 
    534       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
     551      DO jl = 1, jpl                        !  Loop over ice categories  ! 
    535552         !                                  ! ========================== ! 
    536553         DO jj = 1 , jpj 
    … …  
    539556               !      I   Radiative FLUXES   ! 
    540557               ! ----------------------------! 
    541                zst2 = pst(ji,jj,jl) * pst(ji,jj,jl) 
    542                zst3 = pst(ji,jj,jl) * zst2 
     558               zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 
     559               zst3 = ptsu(ji,jj,jl) * zst2 
    543560               ! Short Wave (sw) 
    544                p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
     561               qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    545562               ! Long  Wave (lw) 
    546                z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
     563               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    547564               ! lw sensitivity 
    548565               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
    … …  
    554571               ! ... turbulent heat fluxes 
    555572               ! Sensible Heat 
    556                z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
     573               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
    557574               ! Latent Heat 
    558                p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
    559                   &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    560                ! Latent heat sensitivity for ice (Dqla/Dt) 
    561                IF( p_qla(ji,jj,jl) > 0._wp ) THEN 
    562                   p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     575               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * wndm_ice(ji,jj)   &                            
     576                  &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
     577              ! Latent heat sensitivity for ice (Dqla/Dt) 
     578               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
     579                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 
    563580               ELSE 
    564                   p_dqla(ji,jj,jl) = 0._wp 
     581                  dqla_ice(ji,jj,jl) = 0._wp 
    565582               ENDIF 
    566583 
    567584               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    568                z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
     585               z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj) 
    569586 
    570587               ! ----------------------------! 
    … …  
    572589               ! ----------------------------! 
    573590               ! Downward Non Solar flux 
    574                p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl) 
     591               qns_ice (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl) 
    575592               ! Total non solar heat flux sensitivity for ice 
    576                p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) ) 
     593               dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) 
    577594            END DO 
    578595            ! 
    … …  
    581598      END DO 
    582599      ! 
     600      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
     601      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
     602      CALL iom_put( 'snowpre', sprecip * 86400. )                  ! Snow precipitation 
     603      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation 
     604 
     605#if defined  key_lim3 
     606      CALL wrk_alloc( jpi,jpj, zevap, zsnw )  
     607 
     608      ! --- evaporation --- ! 
     609      z1_lsub = 1._wp / Lsub 
     610      evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 
     611      devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 
     612      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean 
     613 
     614      ! --- evaporation minus precipitation --- ! 
     615      zsnw(:,:) = 0._wp 
     616      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing  
     617      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
     618      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
     619      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
     620 
     621      ! --- heat flux associated with emp --- ! 
     622      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst 
     623         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
     624         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
     625         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     626      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
     627         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     628 
     629      ! --- total solar and non solar fluxes --- ! 
     630      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
     631      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     632 
     633      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     634      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     635 
     636      CALL wrk_dealloc( jpi,jpj, zevap, zsnw )  
     637#endif 
     638 
    583639      !-------------------------------------------------------------------- 
    584640      ! FRACTIONs of net shortwave radiation which is not absorbed in the 
    … …  
    586642      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    587643      ! 
    588       p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
    589       p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    590       ! 
    591       p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
    592       p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    593       CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation 
    594       CALL iom_put( 'precip' , p_tpr * 86400. )                  ! Total precipitation 
     644      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     645      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     646      ! 
    595647      ! 
    596648      IF(ln_ctl) THEN 
    597          CALL prt_ctl(tab3d_1=p_qla   , clinfo1=' blk_ice_core: p_qla  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb  : ', kdim=ijpl) 
    598          CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw  : ', tab3d_2=p_dqla  , clinfo2=' p_dqla : ', kdim=ijpl) 
    599          CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw : ', kdim=ijpl) 
    600          CALL prt_ctl(tab3d_1=p_dqns  , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr   , clinfo2=' p_qsr  : ', kdim=ijpl) 
    601          CALL prt_ctl(tab3d_1=pst     , clinfo1=' blk_ice_core: pst    : ', tab3d_2=p_qns   , clinfo2=' p_qns  : ', kdim=ijpl) 
    602          CALL prt_ctl(tab2d_1=p_tpr   , clinfo1=' blk_ice_core: p_tpr  : ', tab2d_2=p_spr   , clinfo2=' p_spr  : ') 
    603          CALL prt_ctl(tab2d_1=p_taui  , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj  , clinfo2=' p_tauj : ') 
    604          CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ') 
    605       ENDIF 
    606  
    607       CALL wrk_dealloc( jpi,jpj,   z_wnds_t ) 
    608       CALL wrk_dealloc( jpi,jpj,   pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    609       ! 
    610       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core') 
    611       ! 
    612    END SUBROUTINE blk_ice_core 
    613  
    614  
    615    SUBROUTINE blk_bio_meanqsr 
    616       !!--------------------------------------------------------------------- 
    617       !!                     ***  ROUTINE blk_bio_meanqsr 
    618       !!                      
    619       !! ** Purpose :   provide daily qsr_mean for PISCES when 
    620       !!                analytic diurnal cycle is applied in physic 
    621       !!                 
    622       !! ** Method  :   add part where there is no ice 
    623       !!  
    624       !!--------------------------------------------------------------------- 
    625       IF( nn_timing == 1 )  CALL timing_start('blk_bio_meanqsr') 
    626       ! 
    627       qsr_mean(:,:) = (1. - albo ) *  sf(jp_qsr)%fnow(:,:,1) 
    628       ! 
    629       IF( nn_timing == 1 )  CALL timing_stop('blk_bio_meanqsr') 
    630       ! 
    631    END SUBROUTINE blk_bio_meanqsr 
    632   
    633   
    634    SUBROUTINE blk_ice_meanqsr( palb, p_qsr_mean, pdim ) 
    635       !!--------------------------------------------------------------------- 
    636       !! 
    637       !! ** Purpose :   provide the daily qsr_mean over sea_ice for PISCES when 
    638       !!                analytic diurnal cycle is applied in physic 
    639       !! 
    640       !! ** Method  :   compute qsr 
    641       !!  
    642       !!--------------------------------------------------------------------- 
    643       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb       ! ice albedo (clear sky) (alb_ice_cs)               [%] 
    644       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr_mean !     solar heat flux over ice (T-point)         [W/m2] 
    645       INTEGER                   , INTENT(in   ) ::   pdim       ! number of ice categories 
    646       ! 
    647       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays) 
    648       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    649       REAL(wp) ::   zztmp         ! temporary variable 
    650       !!--------------------------------------------------------------------- 
    651       IF( nn_timing == 1 )  CALL timing_start('blk_ice_meanqsr') 
    652       ! 
    653       ijpl  = pdim                            ! number of ice categories 
    654       zztmp = 1. / ( 1. - albo ) 
    655       !                                     ! ========================== ! 
    656       DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    657          !                                  ! ========================== ! 
    658          DO jj = 1 , jpj 
    659             DO ji = 1, jpi 
    660                   p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 
    661             END DO 
    662          END DO 
    663       END DO 
    664       ! 
    665       IF( nn_timing == 1 )  CALL timing_stop('blk_ice_meanqsr') 
    666       ! 
    667    END SUBROUTINE blk_ice_meanqsr   
    668  
     649         CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_core: qla_ice  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb    : ', kdim=jpl) 
     650         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw    : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl) 
     651         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb   : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw   : ', kdim=jpl) 
     652         CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice_core: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice  : ', kdim=jpl) 
     653         CALL prt_ctl(tab3d_1=ptsu    , clinfo1=' blk_ice_core: ptsu     : ', tab3d_2=qns_ice , clinfo2=' qns_ice  : ', kdim=jpl) 
     654         CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_core: tprecip  : ', tab2d_2=sprecip , clinfo2=' sprecip  : ') 
     655      ENDIF 
     656 
     657      CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
     658      ! 
     659      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core_flx') 
     660       
     661   END SUBROUTINE blk_ice_core_flx 
     662#endif 
    669663 
    670664   SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU,    & 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5500 r5630  
    2121   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2222   USE sbc_ice         ! Surface boundary condition: ice fields 
     23   USE sbcapr 
    2324   USE sbcdcy          ! surface boundary condition: diurnal cycle 
    2425   USE phycst          ! physical constants 
    … …  
    3233   USE cpl_oasis3      ! OASIS3 coupling 
    3334   USE geo2ocean       !  
    34    USE oce   , ONLY : tsn, un, vn 
     35   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 
    3536   USE albedo          ! 
    3637   USE in_out_manager  ! I/O manager 
    … …  
    4041   USE timing          ! Timing 
    4142   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     43   USE eosbn2 
     44   USE sbcrnf   , ONLY : l_rnfcpl 
    4245#if defined key_cpl_carbon_cycle 
    4346   USE p4zflx, ONLY : oce_co2 
    … …  
    4649   USE ice_domain_size, only: ncat 
    4750#endif 
     51#if defined key_lim3 
     52   USE limthd_dh       ! for CALL lim_thd_snwblow 
     53#endif 
     54 
    4855   IMPLICIT NONE 
    4956   PRIVATE 
    50 !EM XIOS-OASIS-MCT compliance 
     57 
    5158   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    5259   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
    … …  
    8996   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
    9097   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
    91    INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
    92  
    93    INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
     98   INTEGER, PARAMETER ::   jpr_sflx   = 34            ! salt flux 
     99   INTEGER, PARAMETER ::   jpr_toce   = 35            ! ocean temperature 
     100   INTEGER, PARAMETER ::   jpr_soce   = 36            ! ocean salinity 
     101   INTEGER, PARAMETER ::   jpr_ocx1   = 37            ! ocean current on grid 1 
     102   INTEGER, PARAMETER ::   jpr_ocy1   = 38            ! 
     103   INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height 
     104   INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction           
     105   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
     106   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
     107   INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     108 
     109   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    94110   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    95111   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature 
    … …  
    106122   INTEGER, PARAMETER ::   jps_ivz1   = 14            ! 
    107123   INTEGER, PARAMETER ::   jps_co2    = 15 
    108    INTEGER, PARAMETER ::   jpsnd      = 15            ! total number of fields sended 
     124   INTEGER, PARAMETER ::   jps_soce   = 16            ! ocean salinity 
     125   INTEGER, PARAMETER ::   jps_ssh    = 17            ! sea surface height 
     126   INTEGER, PARAMETER ::   jps_qsroce = 18            ! Qsr above the ocean 
     127   INTEGER, PARAMETER ::   jps_qnsoce = 19            ! Qns above the ocean 
     128   INTEGER, PARAMETER ::   jps_oemp   = 20            ! ocean freshwater budget (evap - precip) 
     129   INTEGER, PARAMETER ::   jps_sflx   = 21            ! salt flux 
     130   INTEGER, PARAMETER ::   jps_otx1   = 22            ! 2 atmosphere-ocean stress components on grid 1 
     131   INTEGER, PARAMETER ::   jps_oty1   = 23            !  
     132   INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs 
     133   INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module 
     134   INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 
     135   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
     136   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
     137   INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
    109138 
    110139   !                                                         !!** namelist namsbc_cpl ** 
    … …  
    125154   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
    126155                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    127  
    128    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 
    129  
    130156   TYPE ::   DYNARR      
    131157      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   z3    
    … …  
    139165 
    140166   !! Substitution 
     167#  include "domzgr_substitute.h90" 
    141168#  include "vectopt_loop_substitute.h90" 
    142169   !!---------------------------------------------------------------------- 
    … …  
    161188      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    162189#endif 
    163       ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 
     190      ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
    164191      ! 
    165192      sbc_cpl_alloc = MAXVAL( ierr ) 
    … …  
    182209      !!              * initialise the OASIS coupler 
    183210      !!---------------------------------------------------------------------- 
    184       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
     211      INTEGER, INTENT(in) ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
    185212      !! 
    186213      INTEGER ::   jn   ! dummy loop index 
    … …  
    216243         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    217244         WRITE(numout,*)'~~~~~~~~~~~~' 
     245      ENDIF 
     246      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
    218247         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    219248         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
    … …  
    359388      srcv(jpr_oemp)%clname = 'OOEvaMPr'      ! ocean water budget = ocean Evap - ocean precip 
    360389      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
     390      CASE( 'none'          )       ! nothing to do 
    361391      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    362392      CASE( 'conservative'  ) 
    … …  
    370400      !                                                      !     Runoffs & Calving     !    
    371401      !                                                      ! ------------------------- ! 
    372       srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
    373 ! This isn't right - really just want ln_rnf_emp changed 
    374 !                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    375 !                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
    376 !                                                 ENDIF 
     402      srcv(jpr_rnf   )%clname = 'O_Runoff' 
     403      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
     404         srcv(jpr_rnf)%laction = .TRUE. 
     405         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
     406         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     407         IF(lwp) WRITE(numout,*) 
     408         IF(lwp) WRITE(numout,*) '   runoffs received from oasis -> force ln_rnf = ', ln_rnf 
     409      ENDIF 
     410      ! 
    377411      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    378412 
    … …  
    384418      srcv(jpr_qnsmix)%clname = 'O_QnsMix' 
    385419      SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 
     420      CASE( 'none'          )       ! nothing to do 
    386421      CASE( 'oce only'      )   ;   srcv(               jpr_qnsoce   )%laction = .TRUE. 
    387422      CASE( 'conservative'  )   ;   srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. 
    … …  
    399434      srcv(jpr_qsrmix)%clname = 'O_QsrMix' 
    400435      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 
     436      CASE( 'none'          )       ! nothing to do 
    401437      CASE( 'oce only'      )   ;   srcv(               jpr_qsroce   )%laction = .TRUE. 
    402438      CASE( 'conservative'  )   ;   srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. 
    … …  
    414450      ! 
    415451      ! non solar sensitivity mandatory for LIM ice model 
    416       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4) & 
     452      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 
    417453         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    418454      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
    … …  
    447483         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    448484      ENDIF 
    449  
    450       ! Allocate all parts of frcv used for received fields 
     485      !                                                      ! ------------------------------- ! 
     486      !                                                      !   OPA-SAS coupling - rcv by opa !    
     487      !                                                      ! ------------------------------- ! 
     488      srcv(jpr_sflx)%clname = 'O_SFLX' 
     489      srcv(jpr_fice)%clname = 'RIceFrc' 
     490      ! 
     491      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 
     492         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     493         srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     494         srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     495         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 
     496         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point 
     497         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point 
     498         ! Vectors: change of sign at north fold ONLY if on the local grid 
     499         srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 
     500         sn_rcv_tau%clvgrd = 'U,V' 
     501         sn_rcv_tau%clvor = 'local grid' 
     502         sn_rcv_tau%clvref = 'spherical' 
     503         sn_rcv_emp%cldes = 'oce only' 
     504         ! 
     505         IF(lwp) THEN                        ! control print 
     506            WRITE(numout,*) 
     507            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     508            WRITE(numout,*)'               OPA component  ' 
     509            WRITE(numout,*) 
     510            WRITE(numout,*)'  received fields from SAS component ' 
     511            WRITE(numout,*)'                  ice cover ' 
     512            WRITE(numout,*)'                  oce only EMP  ' 
     513            WRITE(numout,*)'                  salt flux  ' 
     514            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     515            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     516            WRITE(numout,*)'                  wind stress U,V on local grid and sperical coordinates ' 
     517            WRITE(numout,*)'                  wind stress module' 
     518            WRITE(numout,*) 
     519         ENDIF 
     520      ENDIF 
     521      !                                                      ! -------------------------------- ! 
     522      !                                                      !   OPA-SAS coupling - rcv by sas  !    
     523      !                                                      ! -------------------------------- ! 
     524      srcv(jpr_toce  )%clname = 'I_SSTSST' 
     525      srcv(jpr_soce  )%clname = 'I_SSSal' 
     526      srcv(jpr_ocx1  )%clname = 'I_OCurx1' 
     527      srcv(jpr_ocy1  )%clname = 'I_OCury1' 
     528      srcv(jpr_ssh   )%clname = 'I_SSHght' 
     529      srcv(jpr_e3t1st)%clname = 'I_E3T1st'    
     530      srcv(jpr_fraqsr)%clname = 'I_FraQsr'    
     531      ! 
     532      IF( nn_components == jp_iam_sas ) THEN 
     533         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     534         IF( .NOT. ln_cpl ) srcv(:)%clgrid  = 'T'       ! force default definition in case of opa <-> sas coupling 
     535         IF( .NOT. ln_cpl ) srcv(:)%nsgn    = 1.        ! force default definition in case of opa <-> sas coupling 
     536         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 
     537         srcv( jpr_e3t1st )%laction = lk_vvl 
     538         srcv(jpr_ocx1)%clgrid = 'U'        ! oce components given at U-point 
     539         srcv(jpr_ocy1)%clgrid = 'V'        !           and           V-point 
     540         ! Vectors: change of sign at north fold ONLY if on the local grid 
     541         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 
     542         ! Change first letter to couple with atmosphere if already coupled OPA 
     543         ! this is nedeed as each variable name used in the namcouple must be unique: 
     544         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 
     545         DO jn = 1, jprcv 
     546            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
     547         END DO 
     548         ! 
     549         IF(lwp) THEN                        ! control print 
     550            WRITE(numout,*) 
     551            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     552            WRITE(numout,*)'               SAS component  ' 
     553            WRITE(numout,*) 
     554            IF( .NOT. ln_cpl ) THEN 
     555               WRITE(numout,*)'  received fields from OPA component ' 
     556            ELSE 
     557               WRITE(numout,*)'  Additional received fields from OPA component : ' 
     558            ENDIF 
     559            WRITE(numout,*)'               sea surface temperature (Celcius) ' 
     560            WRITE(numout,*)'               sea surface salinity '  
     561            WRITE(numout,*)'               surface currents '  
     562            WRITE(numout,*)'               sea surface height '  
     563            WRITE(numout,*)'               thickness of first ocean T level '         
     564            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     565            WRITE(numout,*) 
     566         ENDIF 
     567      ENDIF 
     568       
     569      ! =================================================== ! 
     570      ! Allocate all parts of frcv used for received fields ! 
     571      ! =================================================== ! 
    451572      DO jn = 1, jprcv 
    452573         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    … …  
    454575      ! Allocate taum part of frcv which is used even when not received as coupling field 
    455576      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     577      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     578      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     579      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     580      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     581      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    456582      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    457583      IF( k_ice /= 0 ) THEN 
    … …  
    477603      ssnd(jps_tmix)%clname = 'O_TepMix' 
    478604      SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 
    479       CASE( 'none'         )       ! nothing to do 
    480       CASE( 'oce only'             )   ;   ssnd(   jps_toce            )%laction = .TRUE. 
    481       CASE( 'weighted oce and ice' ) 
     605      CASE( 'none'                                 )       ! nothing to do 
     606      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE. 
     607      CASE( 'oce and ice' , 'weighted oce and ice' ) 
    482608         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
    483609         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl 
    484       CASE( 'mixed oce-ice'        )   ;   ssnd(   jps_tmix            )%laction = .TRUE. 
     610      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE. 
    485611      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    486612      END SELECT 
    487       
     613            
    488614      !                                                      ! ------------------------- ! 
    489615      !                                                      !          Albedo           ! 
    … …  
    492618      ssnd(jps_albmix)%clname = 'O_AlbMix' 
    493619      SELECT CASE( TRIM( sn_snd_alb%cldes ) ) 
    494       CASE( 'none'          )       ! nothing to do 
    495       CASE( 'weighted ice'  )   ;  ssnd(jps_albice)%laction = .TRUE. 
    496       CASE( 'mixed oce-ice' )   ;  ssnd(jps_albmix)%laction = .TRUE. 
     620      CASE( 'none'                 )     ! nothing to do 
     621      CASE( 'ice' , 'weighted ice' )   ; ssnd(jps_albice)%laction = .TRUE. 
     622      CASE( 'mixed oce-ice'        )   ; ssnd(jps_albmix)%laction = .TRUE. 
    497623      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_alb%cldes' ) 
    498624      END SELECT 
    … …  
    518644         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
    519645      ENDIF 
    520  
     646       
    521647      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    522648      CASE( 'none'         )       ! nothing to do 
    … …  
    525651         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    526652            ssnd(jps_hice:jps_hsnw)%nct = jpl 
    527          ELSE 
    528             IF ( jpl > 1 ) THEN 
    529 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
    530             ENDIF 
    531653         ENDIF 
    532654      CASE ( 'weighted ice and snow' )  
    … …  
    567689      !                                                      ! ------------------------- ! 
    568690      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
     691 
     692      !                                                      ! ------------------------------- ! 
     693      !                                                      !   OPA-SAS coupling - snd by opa !    
     694      !                                                      ! ------------------------------- ! 
     695      ssnd(jps_ssh   )%clname = 'O_SSHght'  
     696      ssnd(jps_soce  )%clname = 'O_SSSal'  
     697      ssnd(jps_e3t1st)%clname = 'O_E3T1st'    
     698      ssnd(jps_fraqsr)%clname = 'O_FraQsr' 
     699      ! 
     700      IF( nn_components == jp_iam_opa ) THEN 
     701         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     702         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 
     703         ssnd( jps_e3t1st )%laction = lk_vvl 
     704         ! vector definition: not used but cleaner... 
     705         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point 
     706         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point 
     707         sn_snd_crt%clvgrd = 'U,V' 
     708         sn_snd_crt%clvor = 'local grid' 
     709         sn_snd_crt%clvref = 'spherical' 
     710         ! 
     711         IF(lwp) THEN                        ! control print 
     712            WRITE(numout,*) 
     713            WRITE(numout,*)'  sent fields to SAS component ' 
     714            WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
     715            WRITE(numout,*)'               sea surface salinity '  
     716            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
     717            WRITE(numout,*)'               sea surface height '  
     718            WRITE(numout,*)'               thickness of first ocean T level '         
     719            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     720            WRITE(numout,*) 
     721         ENDIF 
     722      ENDIF 
     723      !                                                      ! ------------------------------- ! 
     724      !                                                      !   OPA-SAS coupling - snd by sas !    
     725      !                                                      ! ------------------------------- ! 
     726      ssnd(jps_sflx  )%clname = 'I_SFLX'      
     727      ssnd(jps_fice2 )%clname = 'IIceFrc' 
     728      ssnd(jps_qsroce)%clname = 'I_QsrOce'    
     729      ssnd(jps_qnsoce)%clname = 'I_QnsOce'    
     730      ssnd(jps_oemp  )%clname = 'IOEvaMPr'  
     731      ssnd(jps_otx1  )%clname = 'I_OTaux1'    
     732      ssnd(jps_oty1  )%clname = 'I_OTauy1'    
     733      ssnd(jps_rnf   )%clname = 'I_Runoff'    
     734      ssnd(jps_taum  )%clname = 'I_TauMod'    
     735      ! 
     736      IF( nn_components == jp_iam_sas ) THEN 
     737         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     738         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 
     739         ! 
     740         ! Change first letter to couple with atmosphere if already coupled with sea_ice 
     741         ! this is nedeed as each variable name used in the namcouple must be unique: 
     742         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 
     743         DO jn = 1, jpsnd 
     744            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
     745         END DO 
     746         ! 
     747         IF(lwp) THEN                        ! control print 
     748            WRITE(numout,*) 
     749            IF( .NOT. ln_cpl ) THEN 
     750               WRITE(numout,*)'  sent fields to OPA component ' 
     751            ELSE 
     752               WRITE(numout,*)'  Additional sent fields to OPA component : ' 
     753            ENDIF 
     754            WRITE(numout,*)'                  ice cover ' 
     755            WRITE(numout,*)'                  oce only EMP  ' 
     756            WRITE(numout,*)'                  salt flux  ' 
     757            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     758            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     759            WRITE(numout,*)'                  wind stress U,V components' 
     760            WRITE(numout,*)'                  wind stress module' 
     761         ENDIF 
     762      ENDIF 
     763 
    569764      ! 
    570765      ! ================================ ! 
    … …  
    572767      ! ================================ ! 
    573768 
    574       CALL cpl_define(jprcv, jpsnd,nn_cplmodel)             
     769      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
     770       
    575771      IF (ln_usecplmask) THEN  
    576772         xcplmask(:,:,:) = 0. 
    … …  
    582778         xcplmask(:,:,:) = 1. 
    583779      ENDIF 
    584       ! 
    585       IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   & 
     780      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
     781      ! 
     782      ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 
     783      IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 )   & 
    586784         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
     785      ncpl_qsr_freq = 86400 / ncpl_qsr_freq 
    587786 
    588787      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
    … …  
    638837      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 
    639838      !!---------------------------------------------------------------------- 
    640       INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    641       INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    642       INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    643       !! 
    644       LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module?? 
     839      INTEGER, INTENT(in)           ::   kt          ! ocean model time step index 
     840      INTEGER, INTENT(in)           ::   k_fsbc      ! frequency of sbc (-> ice model) computation  
     841      INTEGER, INTENT(in)           ::   k_ice       ! ice management in the sbc (=0/1/2/3) 
     842 
     843      !! 
     844      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    645845      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    646846      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
    … …  
    650850      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    651851      REAL(wp) ::   zzx, zzy               ! temporary variables 
    652       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
     852      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
    653853      !!---------------------------------------------------------------------- 
    654854      ! 
    655855      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    656856      ! 
    657       CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    658       !                                                 ! Receive all the atmos. fields (including ice information) 
    659       isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    660       DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    661          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 
     857      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     858      ! 
     859      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     860      ! 
     861      !                                                      ! ======================================================= ! 
     862      !                                                      ! Receive all the atmos. fields (including ice information) 
     863      !                                                      ! ======================================================= ! 
     864      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges 
     865      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
     866         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
    662867      END DO 
    663868 
    … …  
    719924         ! 
    720925      ENDIF 
    721        
    722926      !                                                      ! ========================= ! 
    723927      !                                                      !    wind stress module     !   (taum) 
    … …  
    748952         ENDIF 
    749953      ENDIF 
    750        
     954      ! 
    751955      !                                                      ! ========================= ! 
    752956      !                                                      !      10 m wind speed      !   (wndm) 
    … …  
    761965!CDIR NOVERRCHK 
    762966               DO ji = 1, jpi  
    763                   wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
     967                  frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    764968               END DO 
    765969            END DO 
    766970         ENDIF 
    767       ELSE 
    768          IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
    769971      ENDIF 
    770972 
    … …  
    773975      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    774976         ! 
    775          utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
    776          vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
    777          taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     977         IF( ln_mixcpl ) THEN 
     978            utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 
     979            vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 
     980            taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 
     981            wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 
     982         ELSE 
     983            utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
     984            vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
     985            taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
     986            wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
     987         ENDIF 
    778988         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    779989         !   
    … …  
    781991 
    782992#if defined key_cpl_carbon_cycle 
    783       !                                                              ! atmosph. CO2 (ppm) 
     993      !                                                      ! ================== ! 
     994      !                                                      ! atmosph. CO2 (ppm) ! 
     995      !                                                      ! ================== ! 
    784996      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    785997#endif 
    786998 
     999      !  Fields received by SAS when OASIS coupling 
     1000      !  (arrays no more filled at sbcssm stage) 
     1001      !                                                      ! ================== ! 
     1002      !                                                      !        SSS         ! 
     1003      !                                                      ! ================== ! 
     1004      IF( srcv(jpr_soce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1005         sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 
     1006         CALL iom_put( 'sss_m', sss_m ) 
     1007      ENDIF 
     1008      !                                                
     1009      !                                                      ! ================== ! 
     1010      !                                                      !        SST         ! 
     1011      !                                                      ! ================== ! 
     1012      IF( srcv(jpr_toce)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1013         sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 
     1014         IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN    ! make sure that sst_m is the potential temperature 
     1015            sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 
     1016         ENDIF 
     1017      ENDIF 
     1018      !                                                      ! ================== ! 
     1019      !                                                      !        SSH         ! 
     1020      !                                                      ! ================== ! 
     1021      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1022         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 
     1023         CALL iom_put( 'ssh_m', ssh_m ) 
     1024      ENDIF 
     1025      !                                                      ! ================== ! 
     1026      !                                                      !  surface currents  ! 
     1027      !                                                      ! ================== ! 
     1028      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1029         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
     1030         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1031         CALL iom_put( 'ssu_m', ssu_m ) 
     1032      ENDIF 
     1033      IF( srcv(jpr_ocy1)%laction ) THEN 
     1034         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
     1035         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1036         CALL iom_put( 'ssv_m', ssv_m ) 
     1037      ENDIF 
     1038      !                                                      ! ======================== ! 
     1039      !                                                      !  first T level thickness ! 
     1040      !                                                      ! ======================== ! 
     1041      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling 
     1042         e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 
     1043         CALL iom_put( 'e3t_m', e3t_m(:,:) ) 
     1044      ENDIF 
     1045      !                                                      ! ================================ ! 
     1046      !                                                      !  fraction of solar net radiation ! 
     1047      !                                                      ! ================================ ! 
     1048      IF( srcv(jpr_fraqsr)%laction ) THEN                    ! received by sas in case of opa <-> sas coupling 
     1049         frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 
     1050         CALL iom_put( 'frq_m', frq_m ) 
     1051      ENDIF 
     1052       
    7871053      !                                                      ! ========================= ! 
    788       IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case) 
     1054      IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN   !  heat & freshwater fluxes ! (Ocean only case) 
    7891055         !                                                   ! ========================= ! 
    7901056         ! 
    7911057         !                                                       ! total freshwater fluxes over the ocean (emp) 
    792          SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    793          CASE( 'conservative' ) 
    794             emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
    795          CASE( 'oce only', 'oce and ice' ) 
    796             emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
    797          CASE default 
    798             CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
    799          END SELECT 
     1058         IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 
     1059            SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
     1060            CASE( 'conservative' ) 
     1061               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 
     1062            CASE( 'oce only', 'oce and ice' ) 
     1063               zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 
     1064            CASE default 
     1065               CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 
     1066            END SELECT 
     1067         ELSE 
     1068            zemp(:,:) = 0._wp 
     1069         ENDIF 
    8001070         ! 
    8011071         !                                                        ! runoffs and calving (added in emp) 
    802          IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    803          IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    804          ! 
    805 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    806 !!gm                                       at least should be optional... 
    807 !!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    808 !!            ! remove negative runoff 
    809 !!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    810 !!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    811 !!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    812 !!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    813 !!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points 
    814 !!               zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    815 !!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    816 !!            ENDIF      
    817 !!            ! add runoff to e-p  
    818 !!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    819 !!         ENDIF 
    820 !!gm  end of internal cooking 
     1072         IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1073         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1074          
     1075         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
     1076         ELSE                   ;   emp(:,:) =                              zemp(:,:) 
     1077         ENDIF 
    8211078         ! 
    8221079         !                                                       ! non solar heat flux over the ocean (qns) 
    823          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    824          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1080         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1081         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1082         ELSE                                       ;   zqns(:,:) = 0._wp 
     1083         END IF 
    8251084         ! update qns over the free ocean with: 
    826          qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST) 
    827          IF( srcv(jpr_snow  )%laction )   THEN 
    828               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1085         IF( nn_components /= jp_iam_opa ) THEN 
     1086            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST) 
     1087            IF( srcv(jpr_snow  )%laction ) THEN 
     1088               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1089            ENDIF 
     1090         ENDIF 
     1091         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
     1092         ELSE                   ;   qns(:,:) =                              zqns(:,:) 
    8291093         ENDIF 
    8301094 
    8311095         !                                                       ! solar flux over the ocean          (qsr) 
    832          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
    833          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    834          IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
     1096         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     1097         ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1098         ELSE                                       ;   zqsr(:,:) = 0._wp 
     1099         ENDIF 
     1100         IF( ln_dm2dc .AND. ln_cpl )   zqsr(:,:) = sbc_dcy( zqsr )   ! modify qsr to include the diurnal cycle 
     1101         IF( ln_mixcpl ) THEN   ;   qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 
     1102         ELSE                   ;   qsr(:,:) =                              zqsr(:,:) 
     1103         ENDIF 
    8351104         ! 
    836    
    837       ENDIF 
    838       ! 
    839       CALL wrk_dealloc( jpi,jpj, ztx, zty ) 
     1105         ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 
     1106         IF( srcv(jpr_sflx )%laction )   sfx(:,:) = frcv(jpr_sflx  )%z3(:,:,1) 
     1107         ! Ice cover  (received by opa in case of opa <-> sas coupling) 
     1108         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 
     1109         ! 
     1110 
     1111      ENDIF 
     1112      ! 
     1113      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
    8401114      ! 
    8411115      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
    … …  
    9341208            ! 
    9351209         ENDIF 
    936  
    9371210         !                                                      ! ======================= ! 
    9381211         !                                                      !     put on ice grid     ! 
    … …  
    10561329    
    10571330 
    1058    SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
     1331   SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 
    10591332      !!---------------------------------------------------------------------- 
    10601333      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
    … …  
    10981371      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    10991372      ! optional arguments, used only in 'mixed oce-ice' case 
    1100       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
    1101       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius] 
    1102       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1103       ! 
    1104       INTEGER ::   jl   ! dummy loop index 
    1105       REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr 
     1373      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
     1374      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
     1375      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] 
     1376      ! 
     1377      INTEGER ::   jl         ! dummy loop index 
     1378      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk 
     1379      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 
     1380      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice 
     1381      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM3 
    11061382      !!---------------------------------------------------------------------- 
    11071383      ! 
    11081384      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    11091385      ! 
    1110       CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 
    1111  
     1386      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1387      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
     1388 
     1389      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
    11121390      zicefr(:,:) = 1.- p_frld(:,:) 
    11131391      zcptn(:,:) = rcp * sst_m(:,:) 
    … …  
    11171395      !                                                      ! ========================= ! 
    11181396      ! 
    1119       !                                                           ! total Precipitations - total Evaporation (emp_tot) 
    1120       !                                                           ! solid precipitation  - sublimation       (emp_ice) 
    1121       !                                                           ! solid Precipitation                      (sprecip) 
     1397      !                                                           ! total Precipitation - total Evaporation (emp_tot) 
     1398      !                                                           ! solid precipitation - sublimation       (emp_ice) 
     1399      !                                                           ! solid Precipitation                     (sprecip) 
     1400      !                                                           ! liquid + solid Precipitation            (tprecip) 
    11221401      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    11231402      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1124          sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
    1125          tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
    1126          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
    1127          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1403         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here 
     1404         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 
     1405         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
     1406         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    11281407            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    11291408         IF( iom_use('hflx_rain_cea') )   & 
    … …  
    11361415            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average) 
    11371416      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    1138          emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    1139          emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
    1140          sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
     1417         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1418         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1419         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
     1420         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
    11411421      END SELECT 
     1422 
     1423      IF( iom_use('subl_ai_cea') )   & 
     1424         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
     1425      !    
     1426      !                                                           ! runoffs and calving (put in emp_tot) 
     1427      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1428      IF( srcv(jpr_cal)%laction ) THEN  
     1429         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1430         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
     1431      ENDIF 
     1432 
     1433      IF( ln_mixcpl ) THEN 
     1434         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
     1435         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 
     1436         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 
     1437         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 
     1438      ELSE 
     1439         emp_tot(:,:) =                                  zemp_tot(:,:) 
     1440         emp_ice(:,:) =                                  zemp_ice(:,:) 
     1441         sprecip(:,:) =                                  zsprecip(:,:) 
     1442         tprecip(:,:) =                                  ztprecip(:,:) 
     1443      ENDIF 
    11421444 
    11431445         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
    … …  
    11461448      IF( iom_use('snow_ai_cea') )   & 
    11471449         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average) 
    1148       IF( iom_use('subl_ai_cea') )   & 
    1149          CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    1150       !    
    1151       !                                                           ! runoffs and calving (put in emp_tot) 
    1152       IF( srcv(jpr_rnf)%laction ) THEN  
    1153          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    1154             CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
    1155          IF( iom_use('hflx_rnf_cea') )   & 
    1156             CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    1157       ENDIF 
    1158       IF( srcv(jpr_cal)%laction ) THEN  
    1159          emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    1160          CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
    1161       ENDIF 
    1162       ! 
    1163 !!gm :  this seems to be internal cooking, not sure to need that in a generic interface  
    1164 !!gm                                       at least should be optional... 
    1165 !!       ! remove negative runoff                            ! sum over the global domain 
    1166 !!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1167 !!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
    1168 !!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    1169 !!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
    1170 !!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points 
    1171 !!          zcumulneg = 1.e0 + zcumulneg / zcumulpos 
    1172 !!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    1173 !!       ENDIF      
    1174 !!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
    1175 !! 
    1176 !!gm  end of internal cooking 
    11771450 
    11781451      !                                                      ! ========================= ! 
    … …  
    11801453      !                                                      ! ========================= ! 
    11811454      CASE( 'oce only' )                                     ! the required field is directly provided 
    1182          qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1455         zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    11831456      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1184          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1457         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    11851458         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    1186             qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     1459            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
    11871460         ELSE 
    11881461            ! Set all category values equal for the moment 
    11891462            DO jl=1,jpl 
    1190                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1463               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    11911464            ENDDO 
    11921465         ENDIF 
    11931466      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1194          qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1467         zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    11951468         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    11961469            DO jl=1,jpl 
    1197                qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
    1198                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     1470               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1471               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
    11991472            ENDDO 
    12001473         ELSE 
    12011474            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12021475            DO jl=1,jpl 
    1203                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1476               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1477               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12041478            ENDDO 
    12051479         ENDIF 
    12061480      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    12071481! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    1208          qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1209          qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
     1482         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1483         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    12101484            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
    12111485            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    12121486      END SELECT 
    1213       ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 
    1214       qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with: 
    1215          &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
    1216          &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST) 
    1217          &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
    1218       IF( iom_use('hflx_snow_cea') )   & 
    1219          CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    12201487!!gm 
    1221 !!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
     1488!!    currently it is taken into account in leads budget but not in the zqns_tot, and thus not in  
    12221489!!    the flux that enter the ocean.... 
    12231490!!    moreover 1 - it is not diagnose anywhere....  
    … …  
    12281495      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    12291496         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    1230          qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
     1497         zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 
    12311498         IF( iom_use('hflx_cal_cea') )   & 
    12321499            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12331500      ENDIF 
     1501 
     1502      ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 
     1503      IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1504 
     1505#if defined key_lim3 
     1506      CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1507 
     1508      ! --- evaporation --- ! 
     1509      ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 
     1510      ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 
     1511      !                 but it is incoherent WITH the ice model   
     1512      DO jl=1,jpl 
     1513         evap_ice(:,:,jl) = 0._wp  ! should be: frcv(jpr_ievp)%z3(:,:,1) 
     1514      ENDDO 
     1515      zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 
     1516 
     1517      ! --- evaporation minus precipitation --- ! 
     1518      emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 
     1519 
     1520      ! --- non solar flux over ocean --- ! 
     1521      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1522      zqns_oce = 0._wp 
     1523      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
     1524 
     1525      ! --- heat flux associated with emp --- ! 
     1526      zsnw(:,:) = 0._wp 
     1527      CALL lim_thd_snwblow( p_frld, zsnw )  ! snow distribution over ice after wind blowing 
     1528      zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap 
     1529         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip 
     1530         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 
     1531      qemp_ice(:,:)  = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
     1532         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
     1533 
     1534      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     1535      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1536 
     1537      ! --- total non solar flux --- ! 
     1538      zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 
     1539 
     1540      ! --- in case both coupled/forced are active, we must mix values --- !  
     1541      IF( ln_mixcpl ) THEN 
     1542         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 
     1543         qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 
     1544         DO jl=1,jpl 
     1545            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1546         ENDDO 
     1547         qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 
     1548         qemp_oce (:,:) =  qemp_oce(:,:) * xcplmask(:,:,0) +  zqemp_oce(:,:)* zmsk(:,:) 
     1549!!clem         evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 
     1550      ELSE 
     1551         qns_tot  (:,:  ) = zqns_tot  (:,:  ) 
     1552         qns_oce  (:,:  ) = zqns_oce  (:,:  ) 
     1553         qns_ice  (:,:,:) = zqns_ice  (:,:,:) 
     1554         qprec_ice(:,:)   = zqprec_ice(:,:) 
     1555         qemp_oce (:,:)   = zqemp_oce (:,:) 
     1556      ENDIF 
     1557 
     1558      CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce )  
     1559#else 
     1560 
     1561      ! clem: this formulation is certainly wrong... but better than it was... 
     1562      zqns_tot(:,:) = zqns_tot(:,:)                       &            ! zqns_tot update over free ocean with: 
     1563         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
     1564         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST) 
     1565         &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
     1566 
     1567     IF( ln_mixcpl ) THEN 
     1568         qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1569         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:) 
     1570         DO jl=1,jpl 
     1571            qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) +  zqns_ice(:,:,jl)* zmsk(:,:) 
     1572         ENDDO 
     1573      ELSE 
     1574         qns_tot(:,:  ) = zqns_tot(:,:  ) 
     1575         qns_ice(:,:,:) = zqns_ice(:,:,:) 
     1576      ENDIF 
     1577 
     1578#endif 
    12341579 
    12351580      !                                                      ! ========================= ! 
    … …  
    12371582      !                                                      ! ========================= ! 
    12381583      CASE( 'oce only' ) 
    1239          qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1584         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
    12401585      CASE( 'conservative' ) 
    1241          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1586         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12421587         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    1243             qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1588            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
    12441589         ELSE 
    12451590            ! Set all category values equal for the moment 
    12461591            DO jl=1,jpl 
    1247                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1592               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12481593            ENDDO 
    12491594         ENDIF 
    1250          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1251          qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
     1595         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1596         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    12521597      CASE( 'oce and ice' ) 
    1253          qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1598         zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
    12541599         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    12551600            DO jl=1,jpl 
    1256                qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
    1257                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1601               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     1602               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
    12581603            ENDDO 
    12591604         ELSE 
    12601605            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12611606            DO jl=1,jpl 
    1262                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1607               zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1608               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12631609            ENDDO 
    12641610         ENDIF 
    12651611      CASE( 'mixed oce-ice' ) 
    1266          qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1612         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    12671613! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    12681614!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    12691615!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1270          qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1616         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
    12711617            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
    12721618            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    12731619      END SELECT 
    1274       IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    1275          qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     1620      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle 
     1621         zqsr_tot(:,:  ) = sbc_dcy( zqsr_tot(:,:  ) ) 
    12761622         DO jl=1,jpl 
    1277             qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 
     1623            zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 
    12781624         ENDDO 
     1625      ENDIF 
     1626 
     1627#if defined key_lim3 
     1628      CALL wrk_alloc( jpi,jpj, zqsr_oce )  
     1629      ! --- solar flux over ocean --- ! 
     1630      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1631      zqsr_oce = 0._wp 
     1632      WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:) 
     1633 
     1634      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:) 
     1635      ELSE                   ;   qsr_oce(:,:) = zqsr_oce(:,:)   ;   ENDIF 
     1636 
     1637      CALL wrk_dealloc( jpi,jpj, zqsr_oce )  
     1638#endif 
     1639 
     1640      IF( ln_mixcpl ) THEN 
     1641         qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1642         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:) 
     1643         DO jl=1,jpl 
     1644            qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) +  zqsr_ice(:,:,jl)* zmsk(:,:) 
     1645         ENDDO 
     1646      ELSE 
     1647         qsr_tot(:,:  ) = zqsr_tot(:,:  ) 
     1648         qsr_ice(:,:,:) = zqsr_ice(:,:,:) 
    12791649      ENDIF 
    12801650 
    … …  
    12841654      CASE ('coupled') 
    12851655         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    1286             dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1656            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
    12871657         ELSE 
    12881658            ! Set all category values equal for the moment 
    12891659            DO jl=1,jpl 
    1290                dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1660               zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
    12911661            ENDDO 
    12921662         ENDIF 
    12931663      END SELECT 
    1294  
     1664       
     1665      IF( ln_mixcpl ) THEN 
     1666         DO jl=1,jpl 
     1667            dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 
     1668         ENDDO 
     1669      ELSE 
     1670         dqns_ice(:,:,:) = zdqns_ice(:,:,:) 
     1671      ENDIF 
     1672       
    12951673      !                                                      ! ========================= ! 
    12961674      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
    … …  
    13081686      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    13091687 
    1310       CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     1688      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 
     1689      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 
    13111690      ! 
    13121691      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_ice_flx') 
    … …  
    13281707      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    13291708      INTEGER ::   isec, info   ! local integer 
     1709      REAL(wp) ::   zumax, zvmax 
    13301710      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    13311711      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
    … …  
    13441724      !                                                      ! ------------------------- ! 
    13451725      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    1346          SELECT CASE( sn_snd_temp%cldes) 
    1347          CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
    1348          CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
    1349             SELECT CASE( sn_snd_temp%clcat ) 
    1350             CASE( 'yes' )    
    1351                ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1352             CASE( 'no' ) 
    1353                ztmp3(:,:,:) = 0.0 
     1726          
     1727         IF ( nn_components == jp_iam_opa ) THEN 
     1728            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 
     1729         ELSE 
     1730            ! we must send the surface potential temperature  
     1731            IF( ln_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     1732            ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem) 
     1733            ENDIF 
     1734            ! 
     1735            SELECT CASE( sn_snd_temp%cldes) 
     1736            CASE( 'oce only'             )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1737            CASE( 'oce and ice'          )   ;   ztmp1(:,:) =   ztmp1(:,:) + rt0 
     1738               SELECT CASE( sn_snd_temp%clcat ) 
     1739               CASE( 'yes' )    
     1740                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) 
     1741               CASE( 'no' ) 
     1742                  WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1743                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1744                  ELSEWHERE 
     1745                     ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 
     1746                  END WHERE 
     1747               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1748               END SELECT 
     1749            CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)    
     1750               SELECT CASE( sn_snd_temp%clcat ) 
     1751               CASE( 'yes' )    
     1752                  ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1753               CASE( 'no' ) 
     1754                  ztmp3(:,:,:) = 0.0 
     1755                  DO jl=1,jpl 
     1756                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1757                  ENDDO 
     1758               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1759               END SELECT 
     1760            CASE( 'mixed oce-ice'        )    
     1761               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)  
    13541762               DO jl=1,jpl 
    1355                   ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1763                  ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    13561764               ENDDO 
    1357             CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1765            CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13581766            END SELECT 
    1359          CASE( 'mixed oce-ice'        )    
    1360             ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)  
    1361             DO jl=1,jpl 
    1362                ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    1363             ENDDO 
    1364          CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    1365          END SELECT 
     1767         ENDIF 
    13661768         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    13671769         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info ) 
    … …  
    13721774      !                                                      ! ------------------------- ! 
    13731775      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1374          ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1776         SELECT CASE( sn_snd_alb%cldes ) 
     1777         CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
     1778         CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1779         CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 
     1780         END SELECT 
    13751781         CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    13761782      ENDIF 
    … …  
    13851791      !                                                      !  Ice fraction & Thickness !  
    13861792      !                                                      ! ------------------------- ! 
    1387       ! Send ice fraction field  
     1793      ! Send ice fraction field to atmosphere 
    13881794      IF( ssnd(jps_fice)%laction ) THEN 
    13891795         SELECT CASE( sn_snd_thick%clcat ) 
    … …  
    13921798         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    13931799         END SELECT 
    1394          CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1800         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1801      ENDIF 
     1802       
     1803      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 
     1804      IF( ssnd(jps_fice2)%laction ) THEN 
     1805         ztmp3(:,:,1) = fr_i(:,:) 
     1806         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 
    13951807      ENDIF 
    13961808 
    … …  
    14131825            END SELECT 
    14141826         CASE( 'ice and snow'         )    
    1415             ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
    1416             ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1827            SELECT CASE( sn_snd_thick%clcat ) 
     1828            CASE( 'yes' ) 
     1829               ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
     1830               ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1831            CASE( 'no' ) 
     1832               WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1833                  ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1834                  ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1835               ELSEWHERE 
     1836                 ztmp3(:,:,1) = 0. 
     1837                 ztmp4(:,:,1) = 0. 
     1838               END WHERE 
     1839            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1840            END SELECT 
    14171841         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    14181842         END SELECT 
    … …  
    14401864         !                                                              i-1  i   i 
    14411865         !                                                               i      i+1 (for I) 
    1442          SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    1443          CASE( 'oce only'             )      ! C-grid ==> T 
    1444             DO jj = 2, jpjm1 
    1445                DO ji = fs_2, fs_jpim1   ! vector opt. 
    1446                   zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    1447                   zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    1448                END DO 
    1449             END DO 
    1450          CASE( 'weighted oce and ice' )    
    1451             SELECT CASE ( cp_ice_msh ) 
    1452             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1866         IF( nn_components == jp_iam_opa ) THEN 
     1867            zotx1(:,:) = un(:,:,1)   
     1868            zoty1(:,:) = vn(:,:,1)   
     1869         ELSE         
     1870            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
     1871            CASE( 'oce only'             )      ! C-grid ==> T 
    14531872               DO jj = 2, jpjm1 
    14541873                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1455                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1456                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
    1457                      zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1458                      zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1874                     zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     1875                     zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
    14591876                  END DO 
    14601877               END DO 
    1461             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1462                DO jj = 2, jpjm1 
    1463                   DO ji = 2, jpim1   ! NO vector opt. 
    1464                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1465                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1466                      zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1467                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1468                      zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1469                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1878            CASE( 'weighted oce and ice' )    
     1879               SELECT CASE ( cp_ice_msh ) 
     1880               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1881                  DO jj = 2, jpjm1 
     1882                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1883                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1884                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
     1885                        zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1886                        zity1(ji,jj) = 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1887                     END DO 
    14701888                  END DO 
    1471                END DO 
    1472             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1473                DO jj = 2, jpjm1 
    1474                   DO ji = 2, jpim1   ! NO vector opt. 
    1475                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
    1476                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
    1477                      zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1478                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1479                      zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1480                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1889               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1890                  DO jj = 2, jpjm1 
     1891                     DO ji = 2, jpim1   ! NO vector opt. 
     1892                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1893                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1894                        zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1895                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1896                        zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1897                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1898                     END DO 
    14811899                  END DO 
    1482                END DO 
     1900               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1901                  DO jj = 2, jpjm1 
     1902                     DO ji = 2, jpim1   ! NO vector opt. 
     1903                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   
     1904                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   
     1905                        zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1906                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1907                        zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1908                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1909                     END DO 
     1910                  END DO 
     1911               END SELECT 
     1912               CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
     1913            CASE( 'mixed oce-ice'        ) 
     1914               SELECT CASE ( cp_ice_msh ) 
     1915               CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
     1916                  DO jj = 2, jpjm1 
     1917                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     1918                        zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
     1919                           &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
     1920                        zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
     1921                           &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
     1922                     END DO 
     1923                  END DO 
     1924               CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
     1925                  DO jj = 2, jpjm1 
     1926                     DO ji = 2, jpim1   ! NO vector opt. 
     1927                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1928                           &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
     1929                           &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1930                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1931                           &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
     1932                           &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1933                     END DO 
     1934                  END DO 
     1935               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
     1936                  DO jj = 2, jpjm1 
     1937                     DO ji = 2, jpim1   ! NO vector opt. 
     1938                        zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
     1939                           &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     1940                           &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1941                        zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
     1942                           &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     1943                           &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     1944                     END DO 
     1945                  END DO 
     1946               END SELECT 
    14831947            END SELECT 
    1484             CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
    1485          CASE( 'mixed oce-ice'        ) 
    1486             SELECT CASE ( cp_ice_msh ) 
    1487             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T 
    1488                DO jj = 2, jpjm1 
    1489                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1490                      zotx1(ji,jj) = 0.5 * ( un   (ji,jj,1) + un   (ji-1,jj  ,1) ) * zfr_l(ji,jj)   & 
    1491                         &         + 0.5 * ( u_ice(ji,jj  ) + u_ice(ji-1,jj    ) ) *  fr_i(ji,jj) 
    1492                      zoty1(ji,jj) = 0.5 * ( vn   (ji,jj,1) + vn   (ji  ,jj-1,1) ) * zfr_l(ji,jj)   & 
    1493                         &         + 0.5 * ( v_ice(ji,jj  ) + v_ice(ji  ,jj-1  ) ) *  fr_i(ji,jj) 
    1494                   END DO 
    1495                END DO 
    1496             CASE( 'I' )                      ! Ocean on C grid, Ice on I-point (B-grid) ==> T 
    1497                DO jj = 2, jpjm1 
    1498                   DO ji = 2, jpim1   ! NO vector opt. 
    1499                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1500                         &         + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1)                     & 
    1501                         &                  + u_ice(ji+1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1502                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1503                         &         + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1)                     & 
    1504                         &                  + v_ice(ji+1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1505                   END DO 
    1506                END DO 
    1507             CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    1508                DO jj = 2, jpjm1 
    1509                   DO ji = 2, jpim1   ! NO vector opt. 
    1510                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    1511                         &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    1512                         &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1513                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    1514                         &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    1515                         &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    1516                   END DO 
    1517                END DO 
    1518             END SELECT 
    1519          END SELECT 
    1520          CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1948            CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. )   ;   CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 
     1949            ! 
     1950         ENDIF 
    15211951         ! 
    15221952         ! 
    … …  
    15581988      ENDIF 
    15591989      ! 
     1990      ! 
     1991      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 
     1992      !                                                        ! SSH 
     1993      IF( ssnd(jps_ssh )%laction )  THEN 
     1994         !                          ! removed inverse barometer ssh when Patm 
     1995         !                          forcing is used (for sea-ice dynamics) 
     1996         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     1997         ELSE                    ;   ztmp1(:,:) = sshn(:,:) 
     1998         ENDIF 
     1999         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info ) 
     2000 
     2001      ENDIF 
     2002      !                                                        ! SSS 
     2003      IF( ssnd(jps_soce  )%laction )  THEN 
     2004         CALL cpl_snd( jps_soce  , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 
     2005      ENDIF 
     2006      !                                                        ! first T level thickness  
     2007      IF( ssnd(jps_e3t1st )%laction )  THEN 
     2008         CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1)   , (/jpi,jpj,1/) ), info ) 
     2009      ENDIF 
     2010      !                                                        ! Qsr fraction 
     2011      IF( ssnd(jps_fraqsr)%laction )  THEN 
     2012         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 
     2013      ENDIF 
     2014      ! 
     2015      !  Fields sent by SAS to OPA when OASIS coupling 
     2016      !                                                        ! Solar heat flux 
     2017      IF( ssnd(jps_qsroce)%laction )  CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 
     2018      IF( ssnd(jps_qnsoce)%laction )  CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 
     2019      IF( ssnd(jps_oemp  )%laction )  CALL cpl_snd( jps_oemp  , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 
     2020      IF( ssnd(jps_sflx  )%laction )  CALL cpl_snd( jps_sflx  , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 
     2021      IF( ssnd(jps_otx1  )%laction )  CALL cpl_snd( jps_otx1  , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 
     2022      IF( ssnd(jps_oty1  )%laction )  CALL cpl_snd( jps_oty1  , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 
     2023      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 
     2024      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 
     2025 
    15602026      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    15612027      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r5500 r5630  
    138138         IF      ( ksbc == jp_flx ) THEN 
    139139            CALL cice_sbc_force(kt) 
    140          ELSE IF ( ksbc == jp_cpl ) THEN 
     140         ELSE IF ( ksbc == jp_purecpl ) THEN 
    141141            CALL sbc_cpl_ice_flx( 1.0-fr_i  ) 
    142142         ENDIF 
    … …  
    146146         CALL cice_sbc_out ( kt, ksbc ) 
    147147 
    148          IF ( ksbc == jp_cpl )  CALL cice_sbc_hadgam(kt+1) 
     148         IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1) 
    149149 
    150150      ENDIF                                          ! End sea-ice time step only 
    … …  
    187187 
    188188! Do some CICE consistency checks 
    189       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
     189      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    190190         IF ( calc_strair .OR. calc_Tsfc ) THEN 
    191191            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
    … …  
    212212 
    213213      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    214       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 
     214      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    215215         DO jl=1,ncat 
    216216            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    319319! forced and coupled case  
    320320 
    321       IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
     321      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    322322 
    323323         ztmpn(:,:,:)=0.0 
    … …  
    509509      CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 
    510510 
    511       CALL wrk_dealloc( jpi,jpj, ztmp ) 
     511      CALL wrk_dealloc( jpi,jpj, ztmp, zpice ) 
    512512      CALL wrk_dealloc( jpi,jpj,ncat, ztmpn ) 
    513513      ! 
    … …  
    587587      ELSE IF (ksbc == jp_core) THEN 
    588588         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    589       ELSE IF (ksbc == jp_cpl) THEN 
     589      ELSE IF (ksbc == jp_purecpl) THEN 
    590590! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
    591591! This is currently as required with the coupling fields from the UM atmosphere 
    … …  
    623623      ENDIF 
    624624! Take into account snow melting except for fully coupled when already in qns_tot 
    625       IF (ksbc == jp_cpl) THEN 
     625      IF (ksbc == jp_purecpl) THEN 
    626626         qsr(:,:)= qsr_tot(:,:) 
    627627         qns(:,:)= qns_tot(:,:) 
    … …  
    658658 
    659659      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    660       IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 
     660      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    661661         DO jl=1,ncat 
    662662            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r5500 r5630  
    105105         fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
    106106 
    107          IF( lk_cpl )   a_i(:,:,1) = fr_i(:,:)          
     107         IF( ln_cpl )   a_i(:,:,1) = fr_i(:,:)          
    108108 
    109109         ! Flux and ice fraction computation 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5500 r5630  
    3737   USE limdyn          ! Ice dynamics 
    3838   USE limtrp          ! Ice transport 
     39   USE limhdf          ! Ice horizontal diffusion 
    3940   USE limthd          ! Ice thermodynamics 
    4041   USE limitd_me       ! Mechanics on ice thickness distribution 
    … …  
    110111      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    111112      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice          ! mean ice albedo (for coupled) 
     113      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice  
    112114      !!---------------------------------------------------------------------- 
    113115 
    114116      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
    115117 
    116       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only 
    117          !-----------------------!                                            
    118          ! --- Bulk Formulae --- !                                            
    119          !-----------------------! 
    120          u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)      ! mean surface ocean current at ice velocity point 
    121          v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)      ! (C-grid dynamics :  U- & V-points as the ocean) 
     118      !-----------------------! 
     119      ! --- Ice time step --- ! 
     120      !-----------------------! 
     121      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
     122 
     123         ! mean surface ocean current at ice velocity point (C-grid dynamics :  U- & V-points as the ocean) 
     124         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 
     125         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 
    122126          
    123127         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    124128         t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )   
    125          !                                                                                       
    126          ! Ice albedo 
    127          CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
    128          CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    129  
    130          ! CORE and COUPLED bulk formulations 
    131          SELECT CASE( kblk ) 
    132          CASE( jp_core , jp_cpl ) 
    133  
    134             ! albedo depends on cloud fraction because of non-linear spectral effects 
    135             zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    136             ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
    137             ! (zalb_ice) is computed within the bulk routine 
    138              
    139          END SELECT 
    140129          
    141130         ! Mask sea ice surface temperature (set to rt0 over land) 
    142131         DO jl = 1, jpl 
    143132            t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 
    144          END DO 
    145       
    146          ! Bulk formulae  - provides the following fields: 
    147          ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2] 
     133         END DO      
     134         ! 
     135         !------------------------------------------------!                                            
     136         ! --- Dynamical coupling with the atmosphere --- !                                            
     137         !------------------------------------------------! 
     138         ! It provides the following fields: 
     139         ! utau_ice, vtau_ice : surface ice stress (U- & V-points)   [N/m2] 
     140         !----------------------------------------------------------------- 
     141         SELECT CASE( kblk ) 
     142         CASE( jp_clio    )   ;   CALL blk_ice_clio_tau                         ! CLIO bulk formulation             
     143         CASE( jp_core    )   ;   CALL blk_ice_core_tau                         ! CORE bulk formulation 
     144         CASE( jp_purecpl )   ;   CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled   formulation 
     145         END SELECT 
     146          
     147         IF( ln_mixcpl) THEN   ! Case of a mixed Bulk/Coupled formulation 
     148            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice) 
     149            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     150            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     151            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     152            CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     153         ENDIF 
     154 
     155         !-------------------------------------------------------! 
     156         ! --- ice dynamics and transport (except in 1D case) ---! 
     157         !-------------------------------------------------------! 
     158         numit = numit + nn_fsbc                  ! Ice model time step 
     159         !                                                    
     160         CALL sbc_lim_bef                         ! Store previous ice values 
     161         CALL sbc_lim_diag0                       ! set diag of mass, heat and salt fluxes to 0 
     162         CALL lim_rst_opn( kt )                   ! Open Ice restart file 
     163         ! 
     164         IF( .NOT. lk_c1d ) THEN 
     165            ! 
     166            CALL lim_dyn( kt )                    ! Ice dynamics    ( rheology/dynamics )    
     167            ! 
     168            CALL lim_trp( kt )                    ! Ice transport   ( Advection/diffusion ) 
     169            ! 
     170            IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 
     171            ! 
     172#if defined key_bdy 
     173            CALL bdy_ice_lim( kt )                ! bdy ice thermo  
     174            IF( ln_icectl )       CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
     175#endif 
     176            ! 
     177            CALL lim_update1( kt )                ! Corrections 
     178            ! 
     179         ENDIF 
     180          
     181         ! previous lead fraction and ice volume for flux calculations 
     182         CALL sbc_lim_bef                         
     183         CALL lim_var_glo2eqv                     ! ht_i and ht_s for ice albedo calculation 
     184         CALL lim_var_agg(1)                      ! at_i for coupling (via pfrld)  
     185         pfrld(:,:)   = 1._wp - at_i(:,:) 
     186         phicif(:,:)  = vt_i(:,:) 
     187          
     188         !------------------------------------------------------!                                            
     189         ! --- Thermodynamical coupling with the atmosphere --- !                                            
     190         !------------------------------------------------------! 
     191         ! It provides the following fields: 
    148192         ! qsr_ice , qns_ice  : solar & non solar heat flux over ice   (T-point)         [W/m2] 
    149193         ! qla_ice            : latent heat flux over ice              (T-point)         [W/m2] 
    … …  
    151195         ! tprecip , sprecip  : total & solid precipitation            (T-point)         [Kg/m2/s] 
    152196         ! fr1_i0  , fr2_i0   : 1sr & 2nd fraction of qsr penetration in ice             [%] 
    153          ! 
     197         !---------------------------------------------------------------------------------------- 
     198         CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     199         CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
     200 
    154201         SELECT CASE( kblk ) 
    155202         CASE( jp_clio )                                       ! CLIO bulk formulation 
    156             CALL blk_ice_clio( t_su , zalb_cs    , zalb_os    , zalb_ice  ,               & 
    157                &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   & 
    158                &                      qla_ice    , dqns_ice   , dqla_ice  ,               & 
    159                &                      tprecip    , sprecip    ,                           & 
    160                &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  ) 
    161             !          
    162             IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    163                &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    164  
     203            ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo  
     204            ! (zalb_ice) is computed within the bulk routine 
     205            CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice ) 
     206            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     207            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    165208         CASE( jp_core )                                       ! CORE bulk formulation 
    166             CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
    167                &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
    168                &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
    169                &                      tprecip   , sprecip   ,                            & 
    170                &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl ) 
    171                ! 
    172             IF( nn_limflx /= 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    173                &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    174             ! 
    175          CASE ( jp_cpl ) 
    176              
    177             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    178  
     209            ! albedo depends on cloud fraction because of non-linear spectral effects 
     210            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     211            CALL blk_ice_core_flx( t_su, zalb_ice ) 
     212            IF( ln_mixcpl      ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     213            IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
     214         CASE ( jp_purecpl ) 
     215            ! albedo depends on cloud fraction because of non-linear spectral effects 
     216            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     217                                 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 
     218            ! clem: evap_ice is forced to 0 in coupled mode for now  
     219            !       but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models 
     220            evap_ice  (:,:,:) = 0._wp   ;   devap_ice (:,:,:) = 0._wp 
     221            IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    179222         END SELECT 
    180           
    181          !------------------------------! 
    182          ! --- LIM-3 main time-step --- ! 
    183          !------------------------------! 
    184          numit = numit + nn_fsbc                     ! Ice model time step 
    185          !                                                    
    186          CALL sbc_lim_bef                   ! Store previous ice values 
    187  
    188          CALL sbc_lim_diag0                 ! set diag of mass, heat and salt fluxes to 0 
    189           
    190          CALL lim_rst_opn( kt )             ! Open Ice restart file 
    191          ! 
    192          ! ---------------------------------------------- 
    193          ! ice dynamics and transport (except in 1D case) 
    194          ! ---------------------------------------------- 
    195          IF( .NOT. lk_c1d ) THEN 
    196              
    197             CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
    198              
    199             CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
    200              
    201             IF( nn_monocat /= 2 ) CALL lim_itd_me  ! Mechanical redistribution ! (ridging/rafting) 
    202  
    203 #if defined key_bdy 
    204             CALL bdy_ice_lim( kt )         ! bdy ice thermo  
    205             IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    206 #endif 
    207             CALL lim_update1( kt ) 
    208              
    209          ENDIF 
    210           
    211          CALL sbc_lim_bef                  ! Store previous ice values 
    212   
    213          ! ---------------------------------------------- 
    214          ! ice thermodynamics 
    215          ! ---------------------------------------------- 
    216          CALL lim_var_agg(1) 
    217           
    218          ! previous lead fraction and ice volume for flux calculations 
    219          pfrld(:,:)   = 1._wp - at_i(:,:) 
    220          phicif(:,:)  = vt_i(:,:) 
    221           
    222          SELECT CASE( kblk ) 
    223          CASE ( jp_cpl ) 
    224             CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su    ) 
    225             IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    226                &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    227             ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 
    228             qla_ice  (:,:,:) = 0._wp 
    229             dqla_ice (:,:,:) = 0._wp 
    230          END SELECT 
    231          ! 
    232          CALL lim_thd( kt )                         ! Ice thermodynamics  
    233           
     223         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
     224 
     225         !----------------------------! 
     226         ! --- ice thermodynamics --- ! 
     227         !----------------------------! 
     228         CALL lim_thd( kt )                         ! Ice thermodynamics       
     229         ! 
    234230         CALL lim_update2( kt )                     ! Corrections 
    235231         ! 
    … …  
    237233         ! 
    238234         IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs  
    239           
     235         ! 
    240236         CALL lim_wri( 1 )                          ! Ice outputs  
    241           
     237         ! 
    242238         IF( kt == nit000 .AND. ln_rstart )   & 
    243239            &             CALL iom_close( numrir )  ! close input ice restart file 
    … …  
    247243         IF( ln_icectl )  CALL lim_ctl( kt )        ! alerts in case of model crash 
    248244         ! 
    249          CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
    250          ! 
    251245      ENDIF   ! End sea-ice time step only 
    252246 
    253       !--------------------------------! 
    254       ! --- at all ocean time step --- ! 
    255       !--------------------------------! 
    256       ! Update surface ocean stresses (only in ice-dynamic case) 
    257       !    otherwise the atm.-ocean stresses are used everywhere 
     247      !-------------------------! 
     248      ! --- Ocean time step --- ! 
     249      !-------------------------! 
     250      ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere 
    258251      IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    259252!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    260253      ! 
    261       IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
     254      IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') 
    262255      ! 
    263256   END SUBROUTINE sbc_ice_lim 
    … …  
    300293      ! 
    301294      CALL lim_itd_init                ! ice thickness distribution initialization 
     295      ! 
     296      CALL lim_hdf_init                ! set ice horizontal diffusion computation parameters 
    302297      ! 
    303298      CALL lim_thd_init                ! set ice thermodynics parameters 
    … …  
    475470 
    476471    
    477    SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice,   & 
    478          &                          pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 
     472   SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 
    479473      !!--------------------------------------------------------------------- 
    480474      !!                  ***  ROUTINE ice_lim_flx  *** 
    … …  
    494488      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqsr_ice   ! net solar flux 
    495489      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdqn_ice   ! non solar flux sensitivity 
    496       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pqla_ice   ! latent heat flux 
    497       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdql_ice   ! latent heat flux sensitivity 
     490      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pevap_ice  ! sublimation 
     491      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation sensitivity 
    498492      ! 
    499493      INTEGER  ::   jl      ! dummy loop index 
    … …  
    504498      REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m   ! Mean solar heat flux over all categories 
    505499      REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m   ! Mean non solar heat flux over all categories 
    506       REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_m   ! Mean latent heat flux over all categories 
     500      REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m  ! Mean sublimation over all categories 
    507501      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m   ! Mean d(qns)/dT over all categories 
    508       REAL(wp), POINTER, DIMENSION(:,:) :: z_dql_m   ! Mean d(qla)/dT over all categories 
     502      REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 
    509503      !!---------------------------------------------------------------------- 
    510504 
    … …  
    514508      SELECT CASE( k_limflx )                              !==  averaged on all ice categories  ==! 
    515509      CASE( 0 , 1 ) 
    516          CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 
    517          ! 
    518          z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 
    519          z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 
    520          z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 
    521          z_qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) ) 
    522          z_dql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) ) 
     510         CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
     511         ! 
     512         z_qns_m  (:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 
     513         z_qsr_m  (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 
     514         z_dqn_m  (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 
     515         z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 
     516         z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 
    523517         DO jl = 1, jpl 
    524             pdqn_ice(:,:,jl) = z_dqn_m(:,:) 
    525             pdql_ice(:,:,jl) = z_dql_m(:,:) 
     518            pdqn_ice  (:,:,jl) = z_dqn_m(:,:) 
     519            pdevap_ice(:,:,jl) = z_devap_m(:,:) 
    526520         END DO 
    527521         ! 
    528522         DO jl = 1, jpl 
    529             pqns_ice(:,:,jl) = z_qns_m(:,:) 
    530             pqsr_ice(:,:,jl) = z_qsr_m(:,:) 
    531             pqla_ice(:,:,jl) = z_qla_m(:,:) 
     523            pqns_ice (:,:,jl) = z_qns_m(:,:) 
     524            pqsr_ice (:,:,jl) = z_qsr_m(:,:) 
     525            pevap_ice(:,:,jl) = z_evap_m(:,:) 
    532526         END DO 
    533527         ! 
    534          CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_qla_m, z_dqn_m, z_dql_m) 
     528         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
    535529      END SELECT 
    536530 
    … …  
    542536         ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) )  
    543537         DO jl = 1, jpl 
    544             pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
    545             pqla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 
    546             pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )  
     538            pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
     539            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
     540            pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )  
    547541         END DO 
    548542         ! 
    … …  
    593587      wfx_spr(:,:) = 0._wp   ;    
    594588       
    595       hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp 
    596589      hfx_thd(:,:) = 0._wp   ;    
    597590      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
    … …  
    610603       
    611604   END SUBROUTINE sbc_lim_diag0 
    612        
     605 
     606      
    613607   FUNCTION fice_cell_ave ( ptab ) 
    614608      !!-------------------------------------------------------------------------- 
    … …  
    620614       
    621615      fice_cell_ave (:,:) = 0.0_wp 
    622        
    623616      DO jl = 1, jpl 
    624617         fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r5500 r5630  
    101101      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo 
    102102      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K) 
     103      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice  
    103104      !!---------------------------------------------------------------------- 
    104  
    105       CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    106105 
    107106      IF( kt == nit000 ) THEN 
    … …  
    124123         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 
    125124# endif 
     125 
     126         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     127         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
     128 
    126129         !  Bulk Formulea ! 
    127130         !----------------! 
    … …  
    132135               DO ji = 2, jpi   ! NO vector opt. possible 
    133136                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) & 
    134                      &           + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     137                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    135138                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) & 
    136                      &           + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
     139                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 
    137140               END DO 
    138141            END DO 
    … …  
    158161 
    159162         SELECT CASE( ksbc ) 
    160          CASE( jp_core , jp_cpl )   ! CORE and COUPLED bulk formulations 
     163         CASE( jp_core , jp_purecpl )   ! CORE and COUPLED bulk formulations 
    161164 
    162165            ! albedo depends on cloud fraction because of non-linear spectral effects 
    … …  
    182185         SELECT CASE( ksbc ) 
    183186         CASE( jp_clio )           ! CLIO bulk formulation 
    184             CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
    185                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    186                &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    187                &                      tprecip    , sprecip    ,                         & 
    188                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
     187!           CALL blk_ice_clio( zsist, zalb_cs    , zalb_os    , zalb_ice   ,            & 
     188!              &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
     189!              &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
     190!              &                      tprecip    , sprecip    ,                         & 
     191!              &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
     192            CALL blk_ice_clio_tau 
     193            CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 
    189194 
    190195         CASE( jp_core )           ! CORE bulk formulation 
    191             CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice   ,            & 
    192                &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   & 
    193                &                      qla_ice    , dqns_ice   , dqla_ice   ,            & 
    194                &                      tprecip    , sprecip    ,                         & 
    195                &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  ) 
    196             IF( ltrcdm2dc_ice )   CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 
    197  
    198          CASE( jp_cpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
     196            CALL blk_ice_core_tau 
     197            CALL blk_ice_core_flx( zsist, zalb_ice ) 
     198 
     199         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 
    199200            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 
    200201         END SELECT 
     202          
     203         IF( ln_mixcpl) THEN 
     204            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
     205            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     206            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     207         ENDIF 
    201208 
    202209         CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point 
    … …  
    228235         END IF 
    229236         !                                             ! Ice surface fluxes in coupled mode  
    230          IF( ksbc == jp_cpl )   THEN 
     237         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations 
    231238            a_i(:,:,1)=fr_i 
    232239            CALL sbc_cpl_ice_flx( frld,                                              & 
    233240            !                                optional arguments, used only in 'mixed oce-ice' case 
    234             &                                             palbi = zalb_ice, psst = sst_m, pist = zsist ) 
     241            &                                             palbi=zalb_ice, psst=sst_m, pist=zsist ) 
    235242            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
    236243         ENDIF 
    237244                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    238245                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes  
    239 #if defined key_top 
    240         IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2 
    241 #endif 
    242246 
    243247         IF(  .NOT. lk_mpp )THEN 
    … …  
    253257         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt ) 
    254258# endif 
     259         ! 
     260         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
     261         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    255262         ! 
    256263      ENDIF                                    ! End sea-ice time step only 
    … …  
    264271      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    265272      ! 
    266       CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 
    267       ! 
    268273   END SUBROUTINE sbc_ice_lim_2 
    269274 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5500 r5630  
    2424   USE phycst           ! physical constants 
    2525   USE sbc_oce          ! Surface boundary condition: ocean fields 
     26   USE trc_oce          ! shared ocean-passive tracers variables 
    2627   USE sbc_ice          ! Surface boundary condition: ice fields 
    2728   USE sbcdcy           ! surface boundary condition: diurnal cycle 
    … …  
    3839   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3940   USE sbccpl           ! surface boundary condition: coupled florulation 
     41   USE cpl_oasis3       ! OASIS routines for coupling 
    4042   USE sbcssr           ! surface boundary condition: sea surface restoring 
    4143   USE sbcrnf           ! surface boundary condition: runoffs 
    … …  
    5153   USE timing           ! Timing 
    5254   USE sbcwave          ! Wave module 
     55   USE bdy_par          ! Require lk_bdy 
    5356 
    5457   IMPLICIT NONE 
    … …  
    8386      INTEGER ::   icpt   ! local integer 
    8487      !! 
    85       NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core,           & 
    86          &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
    87          &             ln_ssr    ,  nn_isf , nn_fwb    , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 
     88      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl,   & 
     89         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   & 
     90         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   & 
     91         &             nn_lsm    , nn_limflx , nn_components, ln_cpl 
    8892      INTEGER  ::   ios 
     93      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm 
     94      LOGICAL  ::   ll_purecpl 
    8995      !!---------------------------------------------------------------------- 
    9096 
    … …  
    114120          nn_ice      =   0 
    115121      ENDIF 
    116       
     122 
    117123      IF(lwp) THEN               ! Control print 
    118124         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
    … …  
    124130         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    125131         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
    126          WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
     132         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl 
     133         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl 
     134         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis 
     135         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components 
    127136         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    128137         WRITE(numout,*) '           Misc. options of sbc : ' 
    … …  
    151160      END SELECT 
    152161      ! 
    153 #if defined key_top && ! defined key_offline 
    154       ltrcdm2dc = (ln_dm2dc .AND. ln_blk_core .AND. nn_ice==2) 
    155       IF( ltrcdm2dc )THEN 
    156          IF(lwp)THEN 
    157             WRITE(numout,*)"analytical diurnal cycle, core bulk formulation and LIM2 use: " 
    158             WRITE(numout,*)"Diurnal cycle on physics but not in passive tracers" 
    159          ENDIF 
    160       ENDIF 
    161 #else  
    162       ltrcdm2dc =  .FALSE. 
    163 #endif 
    164  
    165       ! 
     162      IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   & 
     163         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 
     164      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   & 
     165         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 
     166      IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   & 
     167         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 
     168      IF ( ln_cpl .AND. .NOT. lk_oasis )    & 
     169         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 
     170      IF( ln_mixcpl .AND. .NOT. lk_oasis )    & 
     171         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 
     172      IF( ln_mixcpl .AND. .NOT. ln_cpl )    & 
     173         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 
     174      IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    & 
     175         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 
     176 
    166177      !                              ! allocate sbc arrays 
    167178      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) 
    168179 
    169180      !                          ! Checks: 
    170       IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths  
    171          ln_rnf_mouth  = .false.                       
    172          IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' ) 
    173          nkrnf         = 0 
    174          rnf     (:,:) = 0.0_wp 
    175          rnf_b   (:,:) = 0.0_wp 
    176          rnfmsk  (:,:) = 0.0_wp 
    177          rnfmsk_z(:)   = 0.0_wp 
    178       ENDIF 
    179181      IF( nn_isf .EQ. 0 ) THEN                      ! no specific treatment in vicinity of ice shelf  
    180182         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 
    … …  
    182184         fwfisf_b(:,:) = 0.0_wp 
    183185      END IF 
    184       IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero 
     186      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 
    185187 
    186188      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
    … …  
    192194 
    193195      !                                            ! restartability    
    194       IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
    195           MOD( nstock             , nn_fsbc) /= 0 ) THEN  
    196          WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
    197             &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
    198          CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
    199       ENDIF 
    200       ! 
    201       IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
    202          &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    203       ! 
    204       IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
     196      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   & 
    205197         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 
    206       IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
    207          &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
     198      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   & 
     199         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 
    208200      IF( nn_ice == 4 .AND. lk_agrif )   & 
    209201         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
    … …  
    212204      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   & 
    213205         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 
    214       IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
     206      IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   & 
    215207         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
    216       IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) )   & 
     208      IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) )   & 
    217209         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
    218210 
    219211      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
    220212 
    221       IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   & 
     213      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   & 
    222214         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 
    223215       
    224       IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
    225          &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    226  
    227216      IF ( ln_wave ) THEN 
    228217      !Activated wave module but neither drag nor stokes drift activated 
    … …  
    238227         & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ') 
    239228      ENDIF  
    240        
    241229      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
     230      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 
     231      ! 
    242232      icpt = 0 
    243       IF( ln_ana          ) THEN   ;   nsbc = jp_ana    ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation 
    244       IF( ln_flx          ) THEN   ;   nsbc = jp_flx    ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation 
    245       IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation 
    246       IF( ln_blk_core     ) THEN   ;   nsbc = jp_core   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation 
    247       IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs    ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation 
    248       IF( lk_cpl          ) THEN   ;   nsbc = jp_cpl    ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation 
    249       IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                       ;   ENDIF       ! GYRE analytical formulation 
    250       IF( lk_esopa        )            nsbc = jp_esopa                                      ! esopa test, ALL formulations 
     233      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation 
     234      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
     235      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation 
     236      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core    ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk            formulation 
     237      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation 
     238      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
     239      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation 
     240      IF( nn_components == jp_iam_opa )   & 
     241         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
     242      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations 
    251243      ! 
    252244      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 
    … …  
    259251      IF(lwp) THEN 
    260252         WRITE(numout,*) 
    261          IF( nsbc == jp_esopa )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
    262          IF( nsbc == jp_gyre  )   WRITE(numout,*) '              GYRE analytical formulation' 
    263          IF( nsbc == jp_ana   )   WRITE(numout,*) '              analytical formulation' 
    264          IF( nsbc == jp_flx   )   WRITE(numout,*) '              flux formulation' 
    265          IF( nsbc == jp_clio  )   WRITE(numout,*) '              CLIO bulk formulation' 
    266          IF( nsbc == jp_core  )   WRITE(numout,*) '              CORE bulk formulation' 
    267          IF( nsbc == jp_cpl   )   WRITE(numout,*) '              coupled formulation' 
    268          IF( nsbc == jp_mfs   )   WRITE(numout,*) '              MFS Bulk formulation' 
    269       ENDIF 
    270       ! 
     253         IF( nsbc == jp_esopa   )   WRITE(numout,*) '              ESOPA test All surface boundary conditions' 
     254         IF( nsbc == jp_gyre    )   WRITE(numout,*) '              GYRE analytical formulation' 
     255         IF( nsbc == jp_ana     )   WRITE(numout,*) '              analytical formulation' 
     256         IF( nsbc == jp_flx     )   WRITE(numout,*) '              flux formulation' 
     257         IF( nsbc == jp_clio    )   WRITE(numout,*) '              CLIO bulk formulation' 
     258         IF( nsbc == jp_core    )   WRITE(numout,*) '              CORE bulk formulation' 
     259         IF( nsbc == jp_purecpl )   WRITE(numout,*) '              pure coupled formulation' 
     260         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation' 
     261         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis' 
     262         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation' 
     263         IF( nn_components/= jp_iam_nemo )  & 
     264            &                       WRITE(numout,*) '              + OASIS coupled SAS' 
     265      ENDIF 
     266      ! 
     267      IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
     268      !                                                     !                                            (2) the use of nn_fsbc 
     269 
     270!     nn_fsbc initialization if OPA-SAS coupling via OASIS 
     271!     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
     272      IF ( nn_components /= jp_iam_nemo ) THEN 
     273 
     274         IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 
     275         IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 
     276         ! 
     277         IF(lwp)THEN 
     278            WRITE(numout,*) 
     279            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 
     280            WRITE(numout,*) 
     281         ENDIF 
     282      ENDIF 
     283 
     284      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   & 
     285          MOD( nstock             , nn_fsbc) /= 0 ) THEN  
     286         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   & 
     287            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 
     288         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 
     289      ENDIF 
     290      ! 
     291      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
     292         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
     293      ! 
     294      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   & 
     295         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
     296 
    271297                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    272298      ! 
    273299      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    274300      ! 
     301                               CALL sbc_rnf_init               ! Runof initialisation 
     302      ! 
    275303      IF( nn_ice == 3      )   CALL sbc_lim_init               ! LIM3 initialisation 
    276304 
    277305      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    278       ! 
    279       IF( nsbc   == jp_cpl )   CALL sbc_cpl_init (nn_ice)      ! OASIS initialisation. must be done before first time step 
    280  
     306       
    281307   END SUBROUTINE sbc_init 
    282308 
    … …  
    318344      !                                            ! ---------------------------------------- ! 
    319345      ! 
    320       IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc 
     346      IF ( .NOT. lk_bdy ) then 
     347         IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc 
     348      ENDIF 
    321349                                                         ! (caution called before sbc_ssm) 
    322350      ! 
    323       CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    324       !                                                  ! averaged over nf_sbc time-step 
     351      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
     352      !                                                        ! averaged over nf_sbc time-step 
    325353 
    326354      IF (ln_wave) CALL sbc_wave( kt ) 
    … …  
    333361      CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    334362      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    335       CASE( jp_core  )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    336       CASE( jp_cpl   )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
     363      CASE( jp_core  )    
     364         IF( nn_components == jp_iam_sas ) & 
     365            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA  
     366                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
     367                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m) 
     368      CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation 
     369                                                                        ! 
    337370      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
     371      CASE( jp_none  )  
     372         IF( nn_components == jp_iam_opa ) & 
     373                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
    338374      CASE( jp_esopa )                                 
    339375                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
    … …  
    345381      END SELECT 
    346382 
     383      IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing 
     384 
     385 
    347386      !                                            !==  Misc. Options  ==! 
    348387       
    … …  
    367406      !                                                           ! (update freshwater fluxes) 
    368407!RBbug do not understand why see ticket 667 
    369       !clem-bugsal CALL lbc_lnk( emp, 'T', 1. ) 
     408!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 
     409      CALL lbc_lnk( emp, 'T', 1. ) 
    370410      ! 
    371411      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    … …  
    408448         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    409449         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
    410          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 
     450         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx ) 
    411451      ENDIF 
    412452 
    … …  
    423463         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
    424464         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux 
    425          IF( nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
     465         IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction  
    426466         CALL iom_put( "taum"  , taum       )                   ! wind stress module  
    427467         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r5500 r5630  
    3232 
    3333   PUBLIC   sbc_rnf       ! routine call in sbcmod module 
    34    PUBLIC   sbc_rnf_div   ! routine called in sshwzv module 
     34   PUBLIC   sbc_rnf_div   ! routine called in divcurl module 
    3535   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module 
    3636   PUBLIC   sbc_rnf_init  ! (PUBLIC for TAM) 
    3737   !                                                     !!* namsbc_rnf namelist * 
    38    CHARACTER(len=100), PUBLIC ::   cn_dir          !: Root directory for location of ssr files 
    39    LOGICAL           , PUBLIC ::   ln_rnf_depth    !: depth       river runoffs attribute specified in a file 
    40    LOGICAL           , PUBLIC ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file 
     38   CHARACTER(len=100)         ::   cn_dir          !: Root directory for location of rnf files 
     39   LOGICAL                    ::   ln_rnf_depth      !: depth       river runoffs attribute specified in a file 
     40   LOGICAL                    ::   ln_rnf_depth_ini  !: depth       river runoffs  computed at the initialisation 
     41   REAL(wp)                   ::   rn_rnf_max        !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true ) 
     42   REAL(wp)                   ::   rn_dep_max        !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true ) 
     43   INTEGER                    ::   nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 
     44   LOGICAL                    ::   ln_rnf_tem      !: temperature river runoffs attribute specified in a file 
    4145   LOGICAL           , PUBLIC ::   ln_rnf_sal      !: salinity    river runoffs attribute specified in a file 
    42    LOGICAL           , PUBLIC ::   ln_rnf_emp      !: runoffs into a file to be read or already into precipitation 
    4346   TYPE(FLD_N)       , PUBLIC ::   sn_rnf          !: information about the runoff file to be read 
    44    TYPE(FLD_N)       , PUBLIC ::   sn_cnf          !: information about the runoff mouth file to be read 
     47   TYPE(FLD_N)               ::   sn_cnf          !: information about the runoff mouth file to be read 
    4548   TYPE(FLD_N)                ::   sn_s_rnf        !: information about the salinities of runoff file to be read 
    4649   TYPE(FLD_N)                ::   sn_t_rnf        !: information about the temperatures of runoff file to be read 
    4750   TYPE(FLD_N)                ::   sn_dep_rnf      !: information about the depth which river inflow affects 
    4851   LOGICAL           , PUBLIC ::   ln_rnf_mouth    !: specific treatment in mouths vicinity 
    49    REAL(wp)          , PUBLIC ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used 
     52   REAL(wp)                  ::   rn_hrnf         !: runoffs, depth over which enhanced vertical mixing is used 
    5053   REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s] 
    51    REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff 
     54   REAL(wp)                   ::   rn_rfact        !: multiplicative factor for runoff 
     55 
     56   LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis 
    5257 
    5358   INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths 
    … …  
    5863   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]    
    5964 
    60    TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) 
    61    TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)   
    62    TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)   
     65   TYPE(FLD),       ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) 
     66   TYPE(FLD),       ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)   
     67   TYPE(FLD),       ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)   
    6368  
    6469   !! * Substitutions   
    … …  
    105110      CALL wrk_alloc( jpi,jpj, ztfrz) 
    106111 
    107       ! 
    108       IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures 
    109  
    110112      !                                            ! ---------------------------------------- ! 
    111113      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
    … …  
    116118      ENDIF 
    117119 
    118       !                                                   !-------------------! 
    119       IF( .NOT. ln_rnf_emp ) THEN                         !   Update runoff   ! 
    120          !                                                !-------------------! 
    121          ! 
    122                              CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
    123          IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required 
    124          IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
    125          ! 
    126          ! Runoff reduction only associated to the ORCA2_LIM configuration 
    127          ! when reading the NetCDF file runoff_1m_nomask.nc 
    128          IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN 
    129             WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 
    130                sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 
     120      !                                            !-------------------! 
     121      !                                            !   Update runoff   ! 
     122      !                                            !-------------------! 
     123      ! 
     124      IF( .NOT. l_rnfcpl )   CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
     125      IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required 
     126      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
     127      ! 
     128      ! Runoff reduction only associated to the ORCA2_LIM configuration 
     129      ! when reading the NetCDF file runoff_1m_nomask.nc 
     130      IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN 
     131         WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 
     132            sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 
     133         END WHERE 
     134      ENDIF 
     135      ! 
     136      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     137         ! 
     138         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
     139         ! 
     140         !                                                     ! set temperature & salinity content of runoffs 
     141         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
     142            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     143            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
     144               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    131145            END WHERE 
    132          ENDIF 
    133          ! 
    134          IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    135             ! 
    136             rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
    137             ! 
    138             !                                                     ! set temperature & salinity content of runoffs 
    139             IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
    140                rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    141                WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
    142                    rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    143                END WHERE 
    144                WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
    145                    ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 
    146                    rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 
    147                END WHERE 
    148             ELSE                                                        ! use SST as runoffs temperature 
    149                rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    150             ENDIF 
    151             !                                                           ! use runoffs salinity data 
    152             IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    153             !                                                           ! else use S=0 for runoffs (done one for all in the init) 
    154             IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1 
    155             IF(lk_mpp) CALL mpp_sum(z_err) 
    156             IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' ) 
    157             ! 
    158             CALL iom_put( "runoffs", rnf )         ! output runoffs arrays 
    159          ENDIF 
    160          ! 
    161       ENDIF 
    162       ! 
     146            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
     147               ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 
     148               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 
     149            END WHERE 
     150         ELSE                                                        ! use SST as runoffs temperature 
     151            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
     152         ENDIF 
     153         !                                                           ! use runoffs salinity data 
     154         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     155         !                                                           ! else use S=0 for runoffs (done one for all in the init) 
     156         CALL iom_put( "runoffs", rnf )         ! output runoffs arrays 
     157      ENDIF 
     158      ! 
     159      !                                                ! ---------------------------------------- ! 
    163160      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    164161         !                                             ! ---------------------------------------- ! 
    … …  
    171168         ELSE                                                   !* no restart: set from nit000 values 
    172169            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    173              rnf_b    (:,:  ) = rnf    (:,:  ) 
    174              rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
     170            rnf_b    (:,:  ) = rnf    (:,:  ) 
     171            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
    175172         ENDIF 
    176173      ENDIF 
    … …  
    186183         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 
    187184      ENDIF 
     185      ! 
    188186      CALL wrk_dealloc( jpi,jpj, ztfrz) 
    189187      ! 
    … …  
    211209      zfact = 0.5_wp 
    212210      ! 
    213       IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==! 
     211      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    214212         IF( lk_vvl ) THEN             ! variable volume case 
    215213            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 
    … …  
    255253      !!---------------------------------------------------------------------- 
    256254      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name 
    257       INTEGER           ::   ji, jj, jk    ! dummy loop indices 
     255      INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices 
    258256      INTEGER           ::   ierror, inum  ! temporary integer 
    259257      INTEGER           ::   ios           ! Local integer output status for namelist read 
    260       ! 
    261       NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
     258      INTEGER           ::   nbrec         ! temporary integer 
     259      REAL(wp)          ::   zacoef   
     260      REAL(wp), DIMENSION(12)                 :: zrec             ! times records 
     261      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrnfcl     
     262      REAL(wp), DIMENSION(:,:  ), ALLOCATABLE :: zrnf 
     263      ! 
     264      NAMELIST/namsbc_rnf/ cn_dir            , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
    262265         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
    263          &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact 
    264       !!---------------------------------------------------------------------- 
     266         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     & 
     267         &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file 
     268      !!---------------------------------------------------------------------- 
     269      ! 
     270      !                                         !==  allocate runoff arrays 
     271      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 
     272      ! 
     273      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths  
     274         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl 
     275         nkrnf         = 0 
     276         rnf     (:,:) = 0.0_wp 
     277         rnf_b   (:,:) = 0.0_wp 
     278         rnfmsk  (:,:) = 0.0_wp 
     279         rnfmsk_z(:)   = 0.0_wp 
     280         RETURN 
     281      ENDIF 
    265282      ! 
    266283      !                                   ! ============ 
    … …  
    283300         WRITE(numout,*) '~~~~~~~ ' 
    284301         WRITE(numout,*) '   Namelist namsbc_rnf' 
    285          WRITE(numout,*) '      runoff in a file to be read                ln_rnf_emp   = ', ln_rnf_emp 
    286302         WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth 
    287303         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf 
    … …  
    289305         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact 
    290306      ENDIF 
    291       ! 
    292307      !                                   ! ================== 
    293308      !                                   !   Type of runoff 
    294309      !                                   ! ================== 
    295       !                                         !==  allocate runoff arrays 
    296       IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 
    297       ! 
    298       IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==! 
    299          IF(lwp) WRITE(numout,*) 
    300          IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations' 
    301          IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN 
    302            CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 
    303            ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE. 
    304          ENDIF 
    305          ! 
    306       ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==! 
    307          ! 
     310      ! 
     311      IF( .NOT. l_rnfcpl ) THEN                     
    308312         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow) 
    309313         IF(lwp) WRITE(numout,*) 
    … …  
    314318         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   ) 
    315319         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 
    316          !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print 
    317320         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 
    318          ! 
    319          IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
    320             IF(lwp) WRITE(numout,*) 
    321             IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file' 
    322             ALLOCATE( sf_t_rnf(1), STAT=ierror  ) 
    323             IF( ierror > 0 ) THEN 
    324                CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN 
    325             ENDIF 
    326             ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   ) 
    327             IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 
    328             CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
    329          ENDIF 
    330          ! 
    331          IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures 
    332             IF(lwp) WRITE(numout,*) 
    333             IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file' 
    334             ALLOCATE( sf_s_rnf(1), STAT=ierror  ) 
    335             IF( ierror > 0 ) THEN 
    336                CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN 
    337             ENDIF 
    338             ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   ) 
    339             IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 
    340             CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
    341          ENDIF 
    342          ! 
    343          IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
    344             IF(lwp) WRITE(numout,*) 
    345             IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
    346             rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
    347             IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
    348                IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
    349             ENDIF  
    350             CALL iom_open ( rn_dep_file, inum )                           ! open file 
    351             CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
    352             CALL iom_close( inum )                                        ! close file 
    353             ! 
    354             nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    355             DO jj = 1, jpj 
    356                DO ji = 1, jpi 
    357                   IF( h_rnf(ji,jj) > 0._wp ) THEN 
    358                      jk = 2 
    359                      DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO 
    360                      nk_rnf(ji,jj) = jk 
    361                   ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
    362                   ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
    363                   ELSE 
    364                      CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
    365                      WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 
    366                   ENDIF 
     321      ENDIF 
     322      ! 
     323      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
     324         IF(lwp) WRITE(numout,*) 
     325         IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file' 
     326         ALLOCATE( sf_t_rnf(1), STAT=ierror  ) 
     327         IF( ierror > 0 ) THEN 
     328            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN 
     329         ENDIF 
     330         ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   ) 
     331         IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 
     332         CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 
     333      ENDIF 
     334      ! 
     335      IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures 
     336         IF(lwp) WRITE(numout,*) 
     337         IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file' 
     338         ALLOCATE( sf_s_rnf(1), STAT=ierror  ) 
     339         IF( ierror > 0 ) THEN 
     340            CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN 
     341         ENDIF 
     342         ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   ) 
     343         IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 
     344         CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 
     345      ENDIF 
     346      ! 
     347      IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
     348         IF(lwp) WRITE(numout,*) 
     349         IF(lwp) WRITE(numout,*) '          runoffs depth read in a file' 
     350         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
     351         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
     352            IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
     353         ENDIF 
     354         CALL iom_open ( rn_dep_file, inum )                           ! open file 
     355         CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
     356         CALL iom_close( inum )                                        ! close file 
     357         ! 
     358         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
     359         DO jj = 1, jpj 
     360            DO ji = 1, jpi 
     361               IF( h_rnf(ji,jj) > 0._wp ) THEN 
     362                  jk = 2 
     363                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 
     364                  END DO 
     365                  nk_rnf(ji,jj) = jk 
     366               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
     367               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
     368               ELSE 
     369                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
     370                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 
     371               ENDIF 
     372            END DO 
     373         END DO 
     374         DO jj = 1, jpj                                ! set the associated depth 
     375            DO ji = 1, jpi 
     376               h_rnf(ji,jj) = 0._wp 
     377               DO jk = 1, nk_rnf(ji,jj) 
     378                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
    367379               END DO 
    368380            END DO 
    369             DO jj = 1, jpj                                ! set the associated depth 
    370                DO ji = 1, jpi 
    371                   h_rnf(ji,jj) = 0._wp 
    372                   DO jk = 1, nk_rnf(ji,jj) 
    373                      h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
     381         END DO 
     382         ! 
     383      ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface 
     384         ! 
     385         IF(lwp) WRITE(numout,*) 
     386         IF(lwp) WRITE(numout,*) '    depth of runoff computed once from max value of runoff' 
     387         IF(lwp) WRITE(numout,*) '    max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 
     388         IF(lwp) WRITE(numout,*) '    depth over which runoffs is spread                        rn_dep_max = ', rn_dep_max 
     389         IF(lwp) WRITE(numout,*) '     create (=1) a runoff depth file or not (=0)      nn_rnf_depth_file  = ', nn_rnf_depth_file 
     390 
     391         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file 
     392         CALL iom_gettime( inum, zrec, kntime=nbrec) 
     393         ALLOCATE( zrnfcl(jpi,jpj,nbrec) )     ;      ALLOCATE( zrnf(jpi,jpj) ) 
     394         DO jm = 1, nbrec 
     395            CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm ) 
     396         END DO 
     397         CALL iom_close( inum ) 
     398         zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 )   !  maximum value in time 
     399         DEALLOCATE( zrnfcl ) 
     400         ! 
     401         h_rnf(:,:) = 1. 
     402         ! 
     403         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff) 
     404         ! 
     405         WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs 
     406         ! 
     407         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin 
     408            DO ji = 1, jpi 
     409               IF( zrnf(ji,jj) > 0._wp ) THEN 
     410                  jk = mbkt(ji,jj) 
     411                  h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) ) 
     412               ENDIF 
     413            END DO 
     414         END DO 
     415         ! 
     416         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed 
     417         DO jj = 1, jpj 
     418            DO ji = 1, jpi 
     419               IF( zrnf(ji,jj) > 0._wp ) THEN 
     420                  jk = 2 
     421                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 
    374422                  END DO 
     423                  nk_rnf(ji,jj) = jk 
     424               ELSE 
     425                  nk_rnf(ji,jj) = 1 
     426               ENDIF 
     427            END DO 
     428         END DO 
     429         ! 
     430         DEALLOCATE( zrnf ) 
     431         ! 
     432         DO jj = 1, jpj                                ! set the associated depth 
     433            DO ji = 1, jpi 
     434               h_rnf(ji,jj) = 0._wp 
     435               DO jk = 1, nk_rnf(ji,jj) 
     436                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
    375437               END DO 
    376438            END DO 
    377          ELSE                                       ! runoffs applied at the surface 
    378             nk_rnf(:,:) = 1 
    379             h_rnf (:,:) = fse3t(:,:,1) 
    380          ENDIF 
    381          ! 
     439         END DO 
     440         ! 
     441         IF( nn_rnf_depth_file == 1 ) THEN      !  save  output nb levels for runoff 
     442            IF(lwp) WRITE(numout,*) '              create runoff depht file' 
     443            CALL iom_open  ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     444            CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 
     445            CALL iom_close ( inum ) 
     446         ENDIF 
     447      ELSE                                       ! runoffs applied at the surface 
     448         nk_rnf(:,:) = 1 
     449         h_rnf (:,:) = fse3t(:,:,1) 
    382450      ENDIF 
    383451      ! 
    … …  
    400468         IF( rn_hrnf > 0._wp ) THEN 
    401469            nkrnf = 2 
    402             DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO 
     470            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1 
     471            END DO 
    403472            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 
    404473         ENDIF 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r5500 r5630  
    5858      REAL(wp) ::   zcoef, zf_sbc       ! local scalar 
    5959      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 
    60       REAL(wp), DIMENSION(jpi,jpj)      :: zub, zvb,zdep 
    6160      !!--------------------------------------------------------------------- 
    62        
     61 
    6362      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 
    6463      DO jj = 1, jpj 
    … …  
    6867         END DO 
    6968      END DO 
    70       zub(:,:)        = ub (:,:,1       ) 
    71       zvb(:,:)        = vb (:,:,1       ) 
    72       ! 
    73       IF( lk_vvl ) THEN 
    74          zdep(:,:) = fse3t_n(:,:,1) 
    75       ENDIF 
    76       !                                                   ! ---------------------------------------- ! 
     69      ! 
    7770      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    7871         !                                                ! ---------------------------------------- ! 
    79          ssu_m(:,:) = zub(:,:) 
    80          ssv_m(:,:) = zvb(:,:) 
     72         ssu_m(:,:) = ub(:,:,1) 
     73         ssv_m(:,:) = vb(:,:,1) 
    8174         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    8275         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
    … …  
    8881         ENDIF 
    8982         ! 
    90          IF( lk_vvl )   fse3t_m(:,:) = zdep(:,:) 
     83         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1) 
     84         ! 
     85         frq_m(:,:) = fraqsr_1lev(:,:) 
    9186         ! 
    9287      ELSE 
    … …  
    9792            IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values' 
    9893            zcoef = REAL( nn_fsbc - 1, wp ) 
    99             ssu_m(:,:) = zcoef * zub(:,:) 
    100             ssv_m(:,:) = zcoef * zvb(:,:) 
     94            ssu_m(:,:) = zcoef * ub(:,:,1) 
     95            ssv_m(:,:) = zcoef * vb(:,:,1) 
    10196            IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    10297            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
    … …  
    108103            ENDIF 
    109104            ! 
    110             IF( lk_vvl )   fse3t_m(:,:) = zcoef * zdep(:,:) 
     105            IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_n(:,:,1) 
     106            ! 
     107            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
    111108            !                                             ! ---------------------------------------- ! 
    112109         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
    … …  
    117114            sss_m(:,:) = 0.e0 
    118115            ssh_m(:,:) = 0.e0 
    119             IF( lk_vvl )   fse3t_m(:,:) = 0.e0 
     116            IF( lk_vvl )   e3t_m(:,:) = 0.e0 
     117            frq_m(:,:) = 0.e0 
    120118         ENDIF 
    121119         !                                                ! ---------------------------------------- ! 
    122120         !                                                !        Cumulate at each time step        ! 
    123121         !                                                ! ---------------------------------------- ! 
    124          ssu_m(:,:) = ssu_m(:,:) + zub(:,:) 
    125          ssv_m(:,:) = ssv_m(:,:) + zvb(:,:) 
     122         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
     123         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    126124         IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    127125         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
    … …  
    133131         ENDIF 
    134132         ! 
    135          IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:) 
     133         IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 
     134         ! 
     135         frq_m(:,:) =   frq_m(:,:) + fraqsr_1lev(:,:) 
    136136 
    137137         !                                                ! ---------------------------------------- ! 
    … …  
    144144            ssv_m(:,:) = ssv_m(:,:) * zcoef           ! 
    145145            ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH             [m] 
    146             IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
     146            IF( lk_vvl )   e3t_m(:,:) = fse3t_m(:,:) * zcoef   ! mean vertical scale factor [m] 
     147            frq_m(:,:) = frq_m(:,:) * zcoef   ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
    147148            ! 
    148149         ENDIF 
    … …  
    161162            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  ) 
    162163            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  ) 
    163             IF( lk_vvl ) THEN 
    164                CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m'  , fse3t_m(:,:)  ) 
    165             END IF 
    166             ! 
    167          ENDIF 
    168          ! 
     164            IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  ) 
     165            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  ) 
     166            ! 
     167         ENDIF 
     168         ! 
     169      ENDIF 
     170      ! 
     171      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   ! 
     172         CALL iom_put( 'ssu_m', ssu_m ) 
     173         CALL iom_put( 'ssv_m', ssv_m ) 
     174         CALL iom_put( 'sst_m', sst_m ) 
     175         CALL iom_put( 'sss_m', sss_m ) 
     176         CALL iom_put( 'ssh_m', ssh_m ) 
     177         IF( lk_vvl )   CALL iom_put( 'e3t_m', e3t_m ) 
     178         CALL iom_put( 'frq_m', frq_m ) 
    169179      ENDIF 
    170180      ! 
    … …  
    202212            CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m  )   !   "         "    salinity    (T-point) 
    203213            CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m  )   !   "         "    height      (T-point) 
    204             IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) ) 
     214            IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m ) 
     215            ! fraction of solar net radiation absorbed in 1st T level 
     216            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 
     217               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  ) 
     218            ELSE 
     219               frq_m(:,:) = 1._wp   ! default definition 
     220            ENDIF 
    205221            ! 
    206222            IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN      ! nn_fsbc has changed between 2 runs 
    … …  
    213229               sss_m(:,:) = zcoef * sss_m(:,:) 
    214230               ssh_m(:,:) = zcoef * ssh_m(:,:) 
    215                IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:) 
     231               IF( lk_vvl )   e3t_m(:,:) = zcoef * fse3t_m(:,:) 
     232               frq_m(:,:) = zcoef * frq_m(:,:) 
    216233            ELSE 
    217234               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file' 
    … …  
    220237      ENDIF 
    221238      ! 
     239      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate 
     240         ! 
     241         IF(lwp) WRITE(numout,*) '          default initialisation of ss?_m arrays' 
     242         ssu_m(:,:) = ub(:,:,1) 
     243         ssv_m(:,:) = vb(:,:,1) 
     244         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
     245         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
     246         ENDIF 
     247         sss_m(:,:) = tsn(:,:,1,jp_sal) 
     248         ssh_m(:,:) = sshn(:,:) 
     249         IF( lk_vvl )   e3t_m(:,:) = fse3t_n(:,:,1) 
     250         frq_m(:,:) = 1._wp 
     251         ! 
     252      ENDIF 
     253      ! 
    222254   END SUBROUTINE sbc_ssm_init 
    223255 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r5500 r5630  
    7474   PUBLIC   eos_init       ! called by istate module 
    7575 
    76    !                                          !!* Namelist (nameos) * 
    77    INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    78    LOGICAL , PUBLIC ::   ln_useCT  = .FALSE. ! determine if eos_pt_from_ct is used to compute sst_m 
     76   !                                !!* Namelist (nameos) * 
     77   INTEGER , PUBLIC ::   nn_eos     ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
     78   LOGICAL , PUBLIC ::   ln_useCT  ! determine if eos_pt_from_ct is used to compute sst_m 
    7979 
    8080   !                                   !!!  simplified eos coefficients 
    … …  
    12521252            WRITE(numout,*) '             model uses Conservative Temperature' 
    12531253            WRITE(numout,*) '             Important: model must be initialized with CT and SA fields' 
     1254         ELSE 
     1255            WRITE(numout,*) '             model does not use Conservative Temperature' 
    12541256         ENDIF 
    12551257      ENDIF 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r5500 r5630  
    2121   USE trdtra          ! trends manager: tracers  
    2222   USE in_out_manager  ! I/O manager 
     23   USE iom             ! I/O manager 
     24   USE fldread         ! read input fields 
     25   USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
     26   USE lib_mpp           ! distributed memory computing library 
    2327   USE prtctl          ! Print control 
    2428   USE wrk_nemo        ! Memory Allocation 
    … …  
    3741 
    3842   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend 
     43   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read) 
    3944  
    4045   !! * Substitutions 
    … …  
    9297      END DO 
    9398      ! 
     99      CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. ) 
     100      ! 
    94101      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics 
    95102         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    … …  
    125132      INTEGER  ::   inum                ! temporary logical unit 
    126133      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    127       ! 
    128       NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst  
     134      INTEGER  ::   ierror              ! local integer 
     135      ! 
     136      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read 
     137      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files 
     138      ! 
     139      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir  
    129140      !!---------------------------------------------------------------------- 
    130141 
    … …  
    161172         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 
    162173            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux' 
    163             CALL iom_open ( 'geothermal_heating.nc', inum ) 
    164             CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 
    165             CALL iom_close( inum ) 
    166             qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2 
     174            ! 
     175            ALLOCATE( sf_qgh(1), STAT=ierror ) 
     176            IF( ierror > 0 ) THEN 
     177               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ; 
     178               RETURN 
     179            ENDIF 
     180            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   ) 
     181            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) ) 
     182            ! fill sf_chl with sn_chl and control print 
     183            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   & 
     184               &          'bottom temperature boundary condition', 'nambbc' ) 
     185 
     186            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data 
     187            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 
    167188            ! 
    168189         CASE DEFAULT 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r5500 r5630  
    99   !!            3.0  ! 2008-06  (G. Madec)  applied on ta, sa and called before tranxt in step.F90 
    1010   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    11    !!            3.7  ! 2014-06  (L. Brodeau) new algorithm based on local Brunt-Vaisala freq. 
     11   !!            3.6  ! 2015-05  (L. Brodeau) new algorithm based on local Brunt-Vaisala freq. 
    1212   !!---------------------------------------------------------------------- 
    1313 
    … …  
    6464      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6565      INTEGER  ::   inpcc        ! number of statically instable water column 
    66       INTEGER  ::   jiter, ikbot, ik, ikup, ikdown, ilayer, ikm   ! local integers 
     66      INTEGER  ::   jiter, ikbot, ikp, ikup, ikdown, ilayer, ik_low   ! local integers 
    6767      LOGICAL  ::   l_bottom_reached, l_column_treated 
    6868      REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 
    6969      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 
     70      REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp       ! acceptance criteria for neutrality (N2==0) 
    7071      REAL(wp), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point... 
    7172      REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point... 
    … …  
    7576      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace 
    7677      ! 
    77       !!LB debug: 
    78       LOGICAL, PARAMETER :: l_LB_debug = .FALSE. 
    79       INTEGER :: ilc1, jlc1, klc1, nncpu 
    80       LOGICAL :: lp_monitor_point = .FALSE. 
    81       !!LB debug. 
     78      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 
     79      INTEGER :: ilc1, jlc1, klc1, nncpu         ! actually happening in a water column at point "ilc1, jlc1" 
     80      LOGICAL :: lp_monitor_point = .FALSE.      ! in CPU domain "nncpu" 
    8281      !!---------------------------------------------------------------------- 
    8382      ! 
    … …  
    9796         ENDIF 
    9897 
    99          !LB debug: 
    100          IF( lwp .AND. l_LB_debug ) THEN 
    101             WRITE(numout,*) 
    102             WRITE(numout,*) 'LOLO: entering tra_npc, kt, narea =', kt, narea 
    103          ENDIF 
    104          !LBdebug: Monitoring of 1 column subject to convection... 
    10598         IF( l_LB_debug ) THEN 
    106             ! Location of 1 known convection spot to follow what's happening in the water column 
    107             ilc1 = 54 ;  jlc1 = 15 ; ! Labrador ORCA1 4x4 cpus: 
    108             nncpu = 15  ; ! the CPU domain contains the convection spot 
    109             !ilc1 = 14 ;  jlc1 = 13 ; ! Labrador ORCA1 8x8 cpus: 
    110             !nncpu = 54  ; ! the CPU domain contains the convection spot 
     99            ! Location of 1 known convection site to follow what's happening in the water column 
     100            ilc1 = 45 ;  jlc1 = 3 ; !  ORCA2 4x4, Antarctic coast, more than 2 unstable portions in the  water column...            
     101            nncpu = 1  ;            ! the CPU domain contains the convection spot 
    111102            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...           
    112103         ENDIF 
    113          !LBdebug. 
    114  
    115          CALL eos_rab( tsa, zab )         ! after alpha and beta 
    116          CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala 
     104          
     105         CALL eos_rab( tsa, zab )         ! after alpha and beta (given on T-points) 
     106         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala  (given on W-points) 
    117107         
    118108         inpcc = 0 
    … …  
    134124                     IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE. 
    135125                     ! writing only if on CPU domain where conv region is: 
    136                      lp_monitor_point = (narea == nncpu).AND.lp_monitor_point  
    137                       
    138                      IF(lp_monitor_point) THEN 
    139                         WRITE(numout,*) '' ;WRITE(numout,*) '' ; 
    140                        WRITE(numout,'("Time step = ",i6.6," !!!")')  kt 
    141                         WRITE(numout,'(" *** BEFORE anything, N^2 for point ",i3,",",i3,":" )') ji,jj 
    142                         DO jk = 1, klc1 
    143                            WRITE(numout,*) jk, zvn2(jk) 
    144                         END DO 
    145                         WRITE(numout,*) ' ' 
    146                      ENDIF 
     126                     lp_monitor_point = (narea == nncpu).AND.lp_monitor_point                       
    147127                  ENDIF                                  !LB debug  end 
    148128 
    149129                  ikbot = mbkt(ji,jj)   ! ikbot: ocean bottom T-level 
    150                   ik = 1                ! because N2 is irrelevant at the surface level (will start at ik=2) 
     130                  ikp = 1                  ! because N2 is irrelevant at the surface level (will start at ikp=2) 
    151131                  ilayer = 0 
    152132                  jiter  = 0 
    … …  
    163143                     DO WHILE ( .NOT. l_bottom_reached ) 
    164144 
    165                         ik = ik + 1 
     145                        ikp = ikp + 1 
    166146                        
    167                         !! Checking level ik for instability 
     147                        !! Testing level ikp for instability 
    168148                        !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    169  
    170                         IF( zvn2(ik) < 0. ) THEN ! Instability found! 
    171  
    172                            ikm  = ik              ! first level whith negative N2 
    173                            ilayer = ilayer + 1    ! yet another layer found.... 
    174                            IF(jiter == 1) inpcc = inpcc + 1 
    175  
    176                            IF(l_LB_debug .AND. lp_monitor_point) & 
    177                               & WRITE(numout,*) 'Negative N2 at ik =', ikm, ' layer nb.', ilayer, & 
    178                               & ' inpcc =', inpcc 
    179  
    180                            !! Case we mix with upper regions where N2==0: 
    181                            !! All the points above ikup where N2 == 0 must also be mixed => we go 
    182                            !! upward to find a new ikup, where the layer doesn't have N2==0 
    183                            ikup = ikm 
    184                            DO jk = ikm, 2, -1 
    185                               ikup = ikup - 1 
    186                               IF( (zvn2(jk-1) > 0.).OR.(ikup == 1) ) EXIT 
    187                            END DO 
    188                            
    189                            ! adjusting ikup if the upper part of the unstable column was neutral (N2=0) 
    190                            IF((zvn2(ikup+1) == 0.).AND.(ikup /= 1)) ikup = ikup+1 ; 
    191  
    192                            
    193                            IF( lp_monitor_point )   WRITE(numout,*) ' => ikup is =', ikup, ' layer nb.', ilayer 
    194                            
     149                        IF( zvn2(ikp) <  -zn2_zero ) THEN ! Instability found! 
     150 
     151                           ilayer = ilayer + 1    ! yet another instable portion of the water column found.... 
     152 
     153                           IF( lp_monitor_point ) THEN  
     154                              WRITE(numout,*) 
     155                              IF( ilayer == 1 .AND. jiter == 1 ) THEN   ! first time a column is spoted with an instability 
     156                                 WRITE(numout,*) 
     157                                 WRITE(numout,*) 'Time step = ',kt,' !!!' 
     158                              ENDIF 
     159                              WRITE(numout,*)  ' * Iteration #',jiter,': found instable portion #',ilayer,   & 
     160                                 &                                    ' in column! Starting at ikp =', ikp 
     161                              WRITE(numout,*)  ' *** N2 for point (i,j) = ',ji,' , ',jj 
     162                              DO jk = 1, klc1 
     163                                 WRITE(numout,*) jk, zvn2(jk) 
     164                              END DO 
     165                              WRITE(numout,*) 
     166                           ENDIF 
     167                            
     168 
     169                           IF( jiter == 1 )   inpcc = inpcc + 1  
     170 
     171                           IF( lp_monitor_point )   WRITE(numout, *) 'Negative N2 at ikp =',ikp,' for layer #', ilayer 
     172 
     173                           !! ikup is the uppermost point where mixing will start: 
     174                           ikup = ikp - 1 ! ikup is always "at most at ikp-1", less if neutral levels overlying 
     175                            
     176                           !! If the points above ikp-1 have N2 == 0 they must also be mixed: 
     177                           IF( ikp > 2 ) THEN 
     178                              DO jk = ikp-1, 2, -1 
     179                                 IF( ABS(zvn2(jk)) < zn2_zero ) THEN 
     180                                    ikup = ikup - 1  ! 1 more upper level has N2=0 and must be added for the mixing 
     181                                 ELSE 
     182                                    EXIT 
     183                                 ENDIF 
     184                              END DO 
     185                           ENDIF 
     186                            
     187                           IF( ikup < 1 )   CALL ctl_stop( 'tra_npc :  PROBLEM #1') 
     188 
    195189                           zsum_temp = 0._wp 
    196190                           zsum_sali = 0._wp 
    … …  
    199193                           zsum_z    = 0._wp 
    200194                                                     
    201                            DO jk = ikup, ikbot+1      ! Inside the instable (and overlying neutral) portion of the column 
    202                               ! 
    203                               IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '     -> summing for jk =', jk 
     195                           DO jk = ikup, ikbot      ! Inside the instable (and overlying neutral) portion of the column 
    204196                              ! 
    205197                              zdz       = fse3t(ji,jj,jk) 
    … …  
    209201                              zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz 
    210202                              zsum_z    = zsum_z    + zdz 
    211                               ! 
    212                               !! EXIT if we found the bottom of the unstable portion of the water column     
    213                               IF( (zvn2(jk+1) > 0.).OR.(jk == ikbot ).OR.((jk==ikm).AND.(zvn2(jk+1) == 0.)) )   EXIT 
     203                              !                               
     204                              IF( jk == ikbot ) EXIT ! avoid array-index overshoot in case ikbot = jpk, cause we're calling jk+1 next line 
     205                              !! EXIT when we have reached the last layer that is instable (N2<0) or neutral (N2=0): 
     206                              IF( zvn2(jk+1) > zn2_zero ) EXIT 
    214207                           END DO 
    215208                           
    216                            !ik     = jk !LB remove? 
    217                            ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative N2 
    218                            
    219                            IF(l_LB_debug .AND. lp_monitor_point) & 
    220                               &    WRITE(numout,*) '  => ikdown =', ikdown, '  layer nb.', ilayer 
    221                            
    222                            ! Mixing Temperature and salinity between ikup and ikdown: 
     209                           ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative or neutral N2 
     210                           IF( ikup == ikdown )   CALL ctl_stop( 'tra_npc :  PROBLEM #2') 
     211 
     212                           ! Mixing Temperature, salinity, alpha and beta from ikup to ikdown included: 
    223213                           zta   = zsum_temp/zsum_z 
    224214                           zsa   = zsum_sali/zsum_z 
    … …  
    226216                           zbeta = zsum_beta/zsum_z 
    227217 
    228                            IF(l_LB_debug .AND. lp_monitor_point) THEN 
     218                           IF( lp_monitor_point ) THEN 
     219                              WRITE(numout,*) 'MIXED T, S, alfa and beta between ikup =',ikup,   & 
     220                                 &            ' and ikdown =',ikdown,', in layer #',ilayer 
    229221                              WRITE(numout,*) '  => Mean temp. in that portion =', zta 
    230222                              WRITE(numout,*) '  => Mean sali. in that portion =', zsa 
    231                               WRITE(numout,*) '  => Mean Alpha in that portion =', zalfa 
     223                              WRITE(numout,*) '  => Mean Alfa in that portion =', zalfa 
    232224                              WRITE(numout,*) '  => Mean Beta  in that portion =', zbeta 
    233225                           ENDIF 
    … …  
    240232                              zvab(jk,jp_sal) = zbeta 
    241233                           END DO 
    242                            ! 
    243                            !! Before updating N2, it is possible that another unstable 
    244                            !! layer exists underneath the one we just homogeneized! 
    245                            ik = ikdown 
    246                            !  
    247                         ENDIF  ! IF( zvn2(ik+1) < 0. ) THEN 
    248                         ! 
    249                         IF( ik == ikbot ) l_bottom_reached = .TRUE. 
     234                            
     235                            
     236                           !! Updating N2 in the relvant portion of the water column 
     237                           !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion 
     238                           !! => Need to re-compute N2! will use Alpha and Beta! 
     239                            
     240                           ikup   = MAX(2,ikup)         ! ikup can never be 1 ! 
     241                           ik_low = MIN(ikdown+1,ikbot) ! we must go 1 point deeper than ikdown! 
     242                            
     243                           DO jk = ikup, ik_low              ! we must go 1 point deeper than ikdown! 
     244 
     245                              !! Interpolating alfa and beta at W point: 
     246                              zrw =  (fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk)) & 
     247                                 & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk)) 
     248                              zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw 
     249                              zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw 
     250 
     251                              !! N2 at W point, doing exactly as in eosbn2.F90: 
     252                              zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     & 
     253                                 &            - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  & 
     254                                 &       / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
     255 
     256                              !! OR, faster  => just considering the vertical gradient of density 
     257                              !! as only the signa maters... 
     258                              !zvn2(jk) = (  zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     & 
     259                              !     &      - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  ) 
     260 
     261                           END DO 
     262                         
     263                           ikp = MIN(ikdown+1,ikbot) 
     264                            
     265 
     266                        ENDIF  !IF( zvn2(ikp) < 0. ) 
     267 
     268 
     269                        IF( ikp == ikbot ) l_bottom_reached = .TRUE. 
    250270                        ! 
    251271                     END DO ! DO WHILE ( .NOT. l_bottom_reached ) 
    252272 
    253                      IF( ik /= ikbot )   STOP 'ERROR: tranpc.F90 => PROBLEM #1' 
     273                     IF( ikp /= ikbot )   CALL ctl_stop( 'tra_npc :  PROBLEM #3') 
    254274                     
    255                      ! ******* At this stage ik == ikbot ! ******* 
     275                     ! ******* At this stage ikp == ikbot ! ******* 
    256276                     
    257                      IF( ilayer > 0 ) THEN 
    258                         !! least an unstable layer has been found 
    259                         !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion 
    260                         !! => Need to re-compute N2! will use Alpha and Beta! 
     277                     IF( ilayer > 0 ) THEN      !! least an unstable layer has been found 
    261278                        ! 
    262                         DO jk = ikup+1, ikdown+1   ! we must go 1 point deeper than ikdown!      
    263                            !! Doing exactly as in eosbn2.F90: 
    264                            !! * Except that we only are interested in the sign of N2 !!! 
    265                            !!   => just considering the vertical gradient of density 
    266                            zrw =   (fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk)) & 
    267                                & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk)) 
    268                            zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw 
    269                            zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw 
    270                            
    271                            !zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     & 
    272                            !     &           - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )  & 
    273                            !     &       / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
    274                            zvn2(jk) = (  zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) )     & 
    275                                 &      - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) )  )   
    276                         END DO 
    277  
    278                         IF(l_LB_debug .AND. lp_monitor_point) THEN 
    279                            WRITE(numout, '(" *** After iteration #",i3.3,", N^2 for point ",i3,",",i3,":" )') & 
    280                               & jiter, ji,jj 
     279                        IF( lp_monitor_point ) THEN 
     280                           WRITE(numout,*) 
     281                           WRITE(numout,*) 'After ',jiter,' iteration(s), we neutralized ',ilayer,' instable layer(s)' 
     282                           WRITE(numout,*) '   ==> N2 at i,j=',ji,',',jj,' now looks like this:' 
    281283                           DO jk = 1, klc1 
    282284                              WRITE(numout,*) jk, zvn2(jk) 
    283285                           END DO 
    284                            WRITE(numout,*) ' ' 
     286                           WRITE(numout,*) 
    285287                        ENDIF 
    286  
    287                         ik     = 1  ! starting again at the surface for the next iteration 
     288                        ! 
     289                        ikp    = 1     ! starting again at the surface for the next iteration 
    288290                        ilayer = 0 
    289291                     ENDIF 
    290292                     ! 
    291                      IF( ik >= ikbot ) THEN 
    292                         IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '    --- exiting jiter loop ---' 
    293                         l_column_treated = .TRUE. 
    294                      ENDIF 
     293                     IF( ikp >= ikbot )   l_column_treated = .TRUE. 
    295294                     ! 
    296295                  END DO ! DO WHILE ( .NOT. l_column_treated ) 
    … …  
    300299                  tsa(ji,jj,:,jp_sal) = zvts(:,jp_sal) 
    301300 
    302                   !! lolo:  Should we update something else???? 
    303                   !! => like alpha and beta? 
    304  
    305                   IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '' 
     301                  !! LB:  Potentially some other global variable beside theta and S can be treated here 
     302                  !!      like BGC tracers. 
     303 
     304                  IF( lp_monitor_point )   WRITE(numout,*) 
    306305 
    307306               ENDIF ! IF( tmask(ji,jj,3) == 1 ) THEN 
    … …  
    321320         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    322321         ! 
    323          IF(lwp) THEN 
    324             WRITE(numout,*) 'LOLO: exiting tra_npc, kt =', kt 
    325             WRITE(numout,*)' => number of statically instable water column : ',inpcc 
    326             WRITE(numout,*) '' ; WRITE(numout,*) '' 
     322         IF( lwp .AND. l_LB_debug ) THEN 
     323            WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', inpcc 
     324            WRITE(numout,*) 
    327325         ENDIF 
    328326         ! 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r5500 r5630  
    2727   USE dom_oce         ! ocean space and time domain variables  
    2828   USE sbc_oce         ! surface boundary condition: ocean 
     29   USE sbcrnf          ! river runoffs 
    2930   USE zdf_oce         ! ocean vertical mixing 
    3031   USE domvvl          ! variable volume 
    … …  
    143144      ELSE                                            ! Leap-Frog + Asselin filter time stepping 
    144145         ! 
    145          IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)      
    146          ELSE                 ;   CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level  
     146         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   & 
     147           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl)  
     148         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level  
    147149         ENDIF 
    148150      ENDIF  
    … …  
    241243 
    242244 
    243    SUBROUTINE tra_nxt_vvl( kt, kit000, cdtype, ptb, ptn, pta, kjpt ) 
     245   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt ) 
    244246      !!---------------------------------------------------------------------- 
    245247      !!                   ***  ROUTINE tra_nxt_vvl  *** 
    … …  
    265267      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
    266268      !!---------------------------------------------------------------------- 
    267       INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index 
    268       INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index 
    269       CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator) 
    270       INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers 
    271       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields 
    272       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields 
    273       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend 
     269      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index 
     270      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index 
     271      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step 
     272      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator) 
     273      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers 
     274      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields 
     275      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields 
     276      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend 
     277      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content 
     278      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content 
     279 
    274280      !!      
    275       LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical 
     281      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical 
    276282      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    277283      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
    … …  
    286292      ! 
    287293      IF( cdtype == 'TRA' )  THEN    
    288          ll_tra     = .TRUE.           ! active tracers case   
    289294         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg 
    290295         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration 
     296         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs 
    291297      ELSE                           
    292          ll_tra     = .FALSE.          ! passive tracers case 
    293298         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg 
    294299         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration 
     300         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs 
    295301      ENDIF 
    296302      ! 
    297303      DO jn = 1, kjpt       
    298304         DO jk = 1, jpkm1 
    299             zfact1 = atfp * rdttra(jk) 
     305            zfact1 = atfp * p2dt(jk) 
    300306            zfact2 = zfact1 / rau0 
    301307            DO jj = 1, jpj 
    … …  
    315321                  ztc_f  = ztc_n  + atfp * ztc_d 
    316322                  ! 
    317                   IF( ll_tra .AND. jk == 1 ) THEN           ! first level only for T & S 
    318                       ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 
    319                       ztc_f  = ztc_f  - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) ) 
     323                  IF( jk == 1 ) THEN           ! first level  
     324                     ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) + rnf(ji,jj) - rnf_b(ji,jj) ) 
     325                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 
    320326                  ENDIF 
     327 
    321328                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only) 
    322329                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )  
    323330 
    324                    ze3t_f = 1.e0 / ze3t_f 
    325                    ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered 
    326                    ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta 
    327                    ! 
    328                    IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only) 
    329                       ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d ) 
    330                       pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average 
    331                    ENDIF 
     331                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   &            ! river runoffs 
     332                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &  
     333                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj) 
     334 
     335                  ze3t_f = 1.e0 / ze3t_f 
     336                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered 
     337                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta 
     338                  ! 
     339                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only) 
     340                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d ) 
     341                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average 
     342                  ENDIF 
    332343               END DO 
    333344            END DO 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r5500 r5630  
    3232   USE wrk_nemo       ! Memory Allocation 
    3333   USE timing         ! Timing 
    34    USE sbc_ice, ONLY : lk_lim3 
    3534 
    3635   IMPLICIT NONE 
    … …  
    3837 
    3938   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T) 
    40    PUBLIC   tra_qsr_init  ! routine called by opa.F90 
     39   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90 
    4140 
    4241   !                                 !!* Namelist namtra_qsr: penetrative solar radiation 
    … …  
    5049   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands) 
    5150   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands) 
    52     
     51  
    5352   ! Module variables 
    5453   REAL(wp) ::   xsi0r                           !: inverse of rn_si0 
    … …  
    165164         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution 
    166165         ! clem: store attenuation coefficient of the first ocean level 
    167          IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     166         IF ( ln_qsr_ice ) THEN 
    168167            DO jj = 1, jpj 
    169168               DO ji = 1, jpi 
    170169                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
    171170                     fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
     171                  ELSE 
     172                     fraqsr_1lev(ji,jj) = 1. 
    172173                  ENDIF 
    173174               END DO 
    … …  
    233234               END DO 
    234235               ! clem: store attenuation coefficient of the first ocean level 
    235                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     236               IF ( ln_qsr_ice ) THEN 
    236237                  DO jj = 1, jpj 
    237238                     DO ji = 1, jpi 
    … …  
    256257               END DO 
    257258               ! clem: store attenuation coefficient of the first ocean level 
    258                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     259               IF ( ln_qsr_ice ) THEN 
    259260                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    260261               ENDIF 
    … …  
    279280               END DO 
    280281               ! clem: store attenuation coefficient of the first ocean level 
    281                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     282               IF ( ln_qsr_ice ) THEN 
    282283                  DO jj = 1, jpj 
    283284                     DO ji = 1, jpi 
    … …  
    298299               END DO 
    299300               ! clem: store attenuation coefficient of the first ocean level 
    300                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     301               IF ( ln_qsr_ice ) THEN 
    301302                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    302303               ENDIF 
    … …  
    324325            &                    'at it= ', kt,' date= ', ndastp 
    325326         IF(lwp) WRITE(numout,*) '~~~~' 
    326          CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc ) 
     327         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      ) 
     328         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm  
    327329         ! 
    328330      ENDIF 
    … …  
    379381      ! 
    380382      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
    381       ! 
    382       ! Default value for fraqsr_1lev 
    383       IF( .NOT. ln_rstart ) THEN 
    384          fraqsr_1lev(:,:) = 1._wp 
    385       ENDIF 
    386383      ! 
    387384      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )  
    … …  
    412409         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    413410         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
    414          WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice     
    415411      ENDIF 
    416412 
    … …  
    564560      ENDIF 
    565561      ! 
     562      ! initialisation of fraqsr_1lev used in sbcssm 
     563      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 
     564         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  ) 
     565      ELSE 
     566         fraqsr_1lev(:,:) = 1._wp   ! default definition 
     567      ENDIF 
     568      ! 
    566569      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        )  
    567570      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r5500 r5630  
    2121   USE sbcmod          ! ln_rnf   
    2222   USE sbcrnf          ! River runoff   
     23   USE sbcisf          ! Ice shelf    
    2324   USE traqsr          ! solar radiation penetration 
    2425   USE trd_oce         ! trends: ocean variables 
    … …  
    2728   USE in_out_manager  ! I/O manager 
    2829   USE prtctl          ! Print control 
    29    USE sbcrnf          ! River runoff   
    30    USE sbcisf          ! Ice shelf    
    31    USE sbcmod          ! ln_rnf   
    3230   USE iom 
    3331   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r5500 r5630  
    8888         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    8989      END SELECT 
     90      ! DRAKKAR SSS control { 
     91      ! JMM avoid negative salinities near river outlet ! Ugly fix 
     92      ! JMM : restore negative salinities to small salinities: 
     93      WHERE ( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp 
    9094 
    9195      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r5500 r5630  
    124124      IF(lwp) WRITE(numout,*) '   convection :' 
    125125      ! 
    126       IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: non penetrative convective scheme is not working',   & 
    127          &                                       ' set ln_zdfnpc to FALSE' ) 
     126#if defined key_top 
     127      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: npc scheme is not working with key_top' ) 
     128#endif 
    128129      ! 
    129130      ioptio = 0 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r5500 r5630  
    761761      IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
    762762      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
    763       IF( nn_etau == 3 .AND. .NOT. lk_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
     763      IF( nn_etau == 3 .AND. .NOT. ln_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    764764 
    765765      IF( ln_mxl0 ) THEN 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5500 r5630  
    8282   USE crsini          ! initialise grid coarsening utility 
    8383   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     84   USE sbc_oce, ONLY: lk_oasis 
    8485   USE stopar 
    8586   USE stopts 
    … …  
    197198#if defined key_iomput 
    198199      CALL xios_finalize                ! end mpp communications with xios 
    199       IF( lk_cpl ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
     200      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
    200201#else 
    201       IF( lk_cpl ) THEN  
     202      IF( lk_oasis ) THEN  
    202203         CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
    203204      ELSE 
    … …  
    228229      ! 
    229230      cltxt = '' 
     231      cxios_context = 'nemo' 
    230232      ! 
    231233      !                             ! Open reference namelist and configuration namelist files 
    … …  
    274276#if defined key_iomput 
    275277      IF( Agrif_Root() ) THEN 
    276          IF( lk_cpl ) THEN 
    277             CALL cpl_init( ilocal_comm )                               ! nemo local communicator given by oasis 
    278             CALL xios_initialize( "oceanx",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     278         IF( lk_oasis ) THEN 
     279            CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis 
     280            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
    279281         ELSE 
    280             CALL  xios_initialize( "nemo",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     282            CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
    281283         ENDIF 
    282284      ENDIF 
    283       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
     285      ! Nodes selection (control print return in cltxt) 
     286      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
    284287#else 
    285       IF( lk_cpl ) THEN 
     288      IF( lk_oasis ) THEN 
    286289         IF( Agrif_Root() ) THEN 
    287             CALL cpl_init( ilocal_comm )                       ! nemo local communicator given by oasis 
     290            CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis 
    288291         ENDIF 
    289          narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     292         ! Nodes selection (control print return in cltxt) 
     293         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
    290294      ELSE 
    291295         ilocal_comm = 0 
    292          narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     296         ! Nodes selection (control print return in cltxt) 
     297         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 
    293298      ENDIF 
    294299#endif 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5500 r5630  
    8383      IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
    8484# if defined key_iomput 
    85       IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" ) 
     85      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    8686# endif 
    8787#endif 
    8888                             indic = 0           ! reset to no error condition 
    8989      IF( kstp == nit000 ) THEN 
    90                       CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    91          IF( ln_crs ) CALL iom_init( "nemo_crs" )  ! initialize context for coarse grid 
     90         ! must be done after nemo_init for AGRIF+XIOS+OASIS 
     91                      CALL iom_init(      cxios_context          )  ! iom_put initialization 
     92         IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" )  ! initialize context for coarse grid 
    9293      ENDIF 
    9394 
    9495      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
    95                              CALL iom_setkt( kstp - nit000 + 1, "nemo"     )   ! say to iom that we are at time step kstp 
    96       IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" )   ! say to iom that we are at time step kstp 
     96                             CALL iom_setkt( kstp - nit000 + 1,      cxios_context          )   ! tell iom we are at time step kstp 
     97      IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" )   ! tell iom we are at time step kstp 
    9798 
    9899      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    100101      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    101102      IF( lk_tide    )   CALL sbc_tide( kstp ) 
    102       IF( lk_bdy     )   CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    103  
     103      IF( lk_bdy     )  THEN 
     104         IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib  
     105                         CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
     106      ENDIF 
    104107                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    105108                                                      ! clem: moved here for bdy ice purpose 
    106  
    107109      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    108110      ! Update stochastic parameters and random T/S fluctuations 
    … …  
    168170      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient 
    169171#endif 
    170 #if defined key_traldf_c3d && key_traldf_smag 
     172#if defined key_traldf_c3d && defined key_traldf_smag 
    171173                          CALL ldf_tra_smag( kstp )      ! eddy induced velocity coefficient 
    172174#  endif 
    173 #if defined key_dynldf_c3d && key_dynldf_smag 
     175#if defined key_dynldf_c3d && defined key_dynldf_smag 
    174176                          CALL ldf_dyn_smag( kstp )      ! eddy induced velocity coefficient 
    175177#  endif 
    … …  
    225227      IF( lk_floats  )      CALL flo_stp( kstp )         ! drifting Floats 
    226228      IF( lk_diahth  )      CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    227       IF( .NOT. lk_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
     229      IF( .NOT. ln_cpl )    CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    228230      IF( lk_diadct  )      CALL dia_dct( kstp )         ! Transports 
    229231      IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag 
    … …  
    355357      ! Coupled mode 
    356358      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    357       IF( lk_cpl           )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
     359      IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
    358360      ! 
    359361#if defined key_iomput 
    360362      IF( kstp == nitend .OR. indic < 0 ) THEN  
    361                       CALL iom_context_finalize( "nemo"     ) ! needed for XIOS+AGRIF 
    362          IF( ln_crs ) CALL iom_context_finalize( "nemo_crs" ) !  
     363                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF 
     364         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !  
    363365      ENDIF 
    364366#endif 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r5500 r5630  
    2727   USE sbc_oce          ! surface boundary condition: ocean 
    2828   USE sbctide          ! Tide initialisation 
     29   USE sbcapr           ! surface boundary condition: ssh_ib required by bdydta  
    2930 
    3031   USE traqsr           ! solar radiation penetration      (tra_qsr routine) 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r5500 r5630  
    3232   !!   'key_top'                                                 bio-model           
    3333   !!---------------------------------------------------------------------- 
     34   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .TRUE.   !: TOP model 
    3435   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .TRUE.   !: bio-model light absorption flag 
    3536#else 
    … …  
    3738   !! Default option                          No bio-model light absorption       
    3839   !!---------------------------------------------------------------------- 
     40   LOGICAL, PUBLIC, PARAMETER ::   lk_top     = .FALSE.   !: TOP model 
    3941   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag 
    4042#endif 

  • branches/UKMO/dev_r5107_restart_func_and_date/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r5500 r5630  
    121121 
    122122   LOGICAL ::   linit = .FALSE. 
     123   LOGICAL ::   ldebug = .FALSE. 
    123124   !!---------------------------------------------------------------------- 
    124125   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    … …  
    486487       
    487488      IF( SUM( tree(ii)%ishape ) == 0 ) THEN                    ! create a new branch  
     489         IF(ldebug) PRINT *, 'create new branch ', ii,ishape, isrt, itype 
    488490         tree(ii)%itype = itype                                        ! define the type of this branch  
    489491         tree(ii)%ishape(:) = ishape(:)                                ! define the shape of this branch  
    … …  
    515517         tree(ii)%current%next%in_use = .FALSE.                        ! this leaf is not yet used 
    516518         tree(ii)%current%next%indic = tree(ii)%current%indic + 1      ! number of this leaf 
     519         IF(ldebug) PRINT *, 'add a leaf ', ii, tree(ii)%current%indic 
    517520         tree(ii)%current%next%prev => tree(ii)%current                ! previous leaf of the new leaf is the current leaf 
    518521         tree(ii)%current%next%next => NULL()                          ! next leaf is not yet defined 
Note: See TracChangeset for help on using the changeset viewer.