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

Changeset 7993


Ignore:
Timestamp:
2017-05-02T13:29:51+02:00 (7 years ago)
Author:
frrh
Message:

Merge in missing revisions 6428:2477 inclusive and 6482 from nemo_v3_6_STABLE
branch. In ptic, this includes the fix for restartability of runoff fields in coupled
models. Evolution of coupled models will therefor be affected.

These changes donot affect evolution of the current stand-alone NEMO-CICE GO6
standard configuration.

Work and testing documented in Met Office GMED ticket 320.

Location:
branches/UKMO/dev_r5518_GO6_package
Files:
1 deleted
46 edited
6 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package/ADM/DOC_SCRIPTS/extract_rst.sh

    • Property svn:keywords deleted
    r2246 r7993  
    109109# ========== 
    110110# 
    111 # $Id$ 
     111# $Id: extract_rst.sh 2246 2010-10-13 09:47:23Z rblod $ 
    112112# 
    113113# - fplod 2009-04-20T08:13:37Z aedon.locean-ipsl.upmc.fr (Darwin) 
  • branches/UKMO/dev_r5518_GO6_package/ADM/DOC_SCRIPTS/install.sh

    • Property svn:keywords deleted
    r2246 r7993  
    4747# ========== 
    4848# 
    49 # $Id$ 
     49# $Id: install.sh 2246 2010-10-13 09:47:23Z rblod $ 
    5050# 
    5151# - fplod 2008-09-16T15:24:26Z aedon.locean-ipsl.upmc.fr (Darwin) 
  • branches/UKMO/dev_r5518_GO6_package/ADM/DOC_SCRIPTS/makefile_compile

    • Property svn:keywords deleted
    r2520 r7993  
    2121# ========== 
    2222# 
    23 # $Id$ 
     23# $Id: makefile_compile 2520 2010-12-27 14:43:36Z rblod $ 
    2424# 
    2525# - fplod 20100419T145702Z aedon.locean-ipsl.upmc.fr (Darwin) 
  • branches/UKMO/dev_r5518_GO6_package/DOC/TexFiles/Figures/Fig_GRIFF_MLB_triads.pdf

    • Property svn:keywords deleted
  • branches/UKMO/dev_r5518_GO6_package/DOC/TexFiles/Figures/Fig_OBS_dataplot_main.pdf

    • Property svn:keywords deleted
  • branches/UKMO/dev_r5518_GO6_package/DOC/TexFiles/Figures/Fig_OBS_dataplot_prof.pdf

    • Property svn:keywords deleted
  • branches/UKMO/dev_r5518_GO6_package/DOC/TexFiles/Figures/logo_ALL.pdf

    • Property svn:keywords deleted
  • branches/UKMO/dev_r5518_GO6_package/DOC/TexFiles/Namelist/nambdy_dta

    • Property svn:keywords deleted
  • branches/UKMO/dev_r5518_GO6_package/DOC/TexFiles/Namelist/nambdy_dta2

    • Property svn:keywords deleted
  • branches/UKMO/dev_r5518_GO6_package/DOC/TexFiles/Namelist/nambdy_index

    • Property svn:keywords deleted
  • branches/UKMO/dev_r5518_GO6_package/DOC/TexFiles/Namelist/namdyn_nept

    • Property svn:keywords deleted
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/CONFIG/SHARED/field_def.xml

    r7747 r7993  
    302302         <field id="emp_x_sst"    long_name="Concentration/Dilution term on SST"                                                                                              unit="kg*degree_C/m2/s" /> 
    303303         <field id="emp_x_sss"    long_name="Concentration/Dilution term on SSS"                                                                                              unit="kg*0.001/m2/s" />         
     304         <field id="rnf_x_sst"    long_name="Runoff term on SST"                                                                                                              unit="kg*degC/m2/s" /> 
     305         <field id="rnf_x_sss"    long_name="Runoff term on SSS"                                                                                                              unit="kg*1e-3/m2/s" /> 
    304306        
    305307         <field id="iceconc"      long_name="ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="%"            /> 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F90

    r6487 r7993  
    11! 
    2 ! $Id: modarrays.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F90

    r6487 r7993  
    11! 
    2 ! $Id: modbc.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F90

    r6487 r7993  
    11! 
    2 ! $Id: modbcfunction.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F90

    r6487 r7993  
    11! 
    2 ! $Id: modcluster.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F90

    r6487 r7993  
    11! 
    2 ! $Id: modcurgridfunctions.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F90

    r6487 r7993  
    11! 
    2 ! $Id: modinitvars.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     Agrif (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F90

    r6487 r7993  
    11! 
    2 ! $Id: modinterp.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F90

    r6487 r7993  
    11! 
    2 ! $Id: modinterpbasic.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F90

    r6487 r7993  
    11! 
    2 ! $Id: modmask.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F90

    r6487 r7993  
    11! 
    2 ! $Id: modmpp.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F90

    r6487 r7993  
    11! 
    2 ! $Id: modsauv.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F90

    r6487 r7993  
    11! 
    2 ! $Id: modupdate.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F90

    r6487 r7993  
    11! 
    2 ! $Id: modupdatebasic.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     AGRIF (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F90

    r6487 r7993  
    11! 
    2 ! $Id: modutil.F90 4779 2014-09-19 14:21:37Z rblod $ 
     2! $Id$ 
    33! 
    44!     Agrif (Adaptive Grid Refinement In Fortran) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r6498 r7993  
    234234   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce   !: surface ocean velocity used in ice dynamics 
    235235   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv    !: hor. diffusivity coeff. at U- and V-points [m2/s] 
    236    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pahu , pahv    !: ice hor. eddy diffusivity coef. at U- and V-points 
    237236   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ust2s, hicol   !: friction velocity, ice collection thickness accreted in leads 
    238237   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strp1, strp2   !: strength at previous time steps 
     
    303302   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness [W.m-2] 
    304303 
    305    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice 
     304   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice    
     305   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   pahu3D , pahv3D 
    306306   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d  !: maximum ice concentration 2d array 
    307307 
     
    429429      ALLOCATE( u_oce    (jpi,jpj) , v_oce    (jpi,jpj) ,                           & 
    430430         &      ahiu     (jpi,jpj) , ahiv     (jpi,jpj) ,                           & 
    431          &      pahu     (jpi,jpj) , pahv     (jpi,jpj) ,                           & 
    432431         &      ust2s    (jpi,jpj) , hicol    (jpi,jpj) ,                           & 
    433432         &      strp1    (jpi,jpj) , strp2    (jpi,jpj) , strength  (jpi,jpj) ,     & 
     
    442441         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     & 
    443442         &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) ,                        & 
    444          &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead  (jpi,jpj) ,                     & 
    445          &      rn_amax_2d(jpi,jpj),                                                            & 
    446          &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) ,                       & 
     443         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl), pahu3D(jpi,jpj,jpl+1), pahv3D(jpi,jpj,jpl+1),            & 
     444         &      qlead  (jpi,jpj) , rn_amax_2d(jpi,jpj),                                         & 
     445         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj),      & 
    447446         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,    & 
    448447         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     &  
     
    514513   !!====================================================================== 
    515514END MODULE ice 
     515 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r6486 r7993  
    77   !!             -   !  2001-05 (G. Madec, R. Hordoir) opa norm 
    88   !!            1.0  !  2002-08 (C. Ethe)  F90, free form 
     9   !!            3.0  !  2015-08 (O. Tintó and M. Castrillo)  added lim_hdf (multiple) 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_lim3 
     
    2728   PRIVATE 
    2829 
    29    PUBLIC   lim_hdf         ! called by lim_trp 
     30   PUBLIC   lim_hdf ! called by lim_trp 
    3031   PUBLIC   lim_hdf_init    ! called by sbc_lim_init 
    3132 
     
    4344CONTAINS 
    4445 
    45    SUBROUTINE lim_hdf( ptab ) 
     46   SUBROUTINE lim_hdf( ptab , ihdf_vars , jpl , nlay_i ) 
    4647      !!------------------------------------------------------------------- 
    4748      !!                  ***  ROUTINE lim_hdf  *** 
     
    5455      !! ** Action  :    update ptab with the diffusive contribution 
    5556      !!------------------------------------------------------------------- 
    56       REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab    ! Field on which the diffusion is applied 
    57       ! 
    58       INTEGER                           ::  ji, jj                    ! dummy loop indices 
     57      INTEGER                           :: jpl, nlay_i, isize, ihdf_vars 
     58      REAL(wp),  DIMENSION(:,:,:), INTENT( inout ),TARGET ::   ptab    ! Field on which the diffusion is applied 
     59      ! 
     60      INTEGER                           ::  ji, jj, jk, jl , jm               ! dummy loop indices 
    5961      INTEGER                           ::  iter, ierr           ! local integers 
    60       REAL(wp)                          ::  zrlxint, zconv     ! local scalars 
    61       REAL(wp), POINTER, DIMENSION(:,:) ::  zrlx, zflu, zflv, zdiv0, zdiv, ztab0 
     62      REAL(wp)                          ::  zrlxint     ! local scalars 
     63      REAL(wp), POINTER , DIMENSION ( : )        :: zconv     ! local scalars 
     64      REAL(wp), POINTER , DIMENSION(:,:,:) ::  zrlx,zdiv0, ztab0 
     65      REAL(wp), POINTER , DIMENSION(:,:) ::  zflu, zflv, zdiv 
    6266      CHARACTER(lc)                     ::  charout                   ! local character 
    6367      REAL(wp), PARAMETER               ::  zrelax = 0.5_wp           ! relaxation constant for iterative procedure 
     
    6569      INTEGER , PARAMETER               ::  its    = 100              ! Maximum number of iteration 
    6670      !!------------------------------------------------------------------- 
     71      TYPE(arrayptr)   , ALLOCATABLE, DIMENSION(:) ::   pt2d_array, zrlx_array 
     72      CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) ::   type_array ! define the nature of ptab array grid-points 
     73      !                                                            ! = T , U , V , F , W and I points 
     74      REAL(wp)        , ALLOCATABLE, DIMENSION(:)  ::   psgn_array    ! =-1 the sign change across the north fold boundary 
     75 
     76     !!---------------------------------------------------------------------  
     77 
     78      !                       !==  Initialisation  ==! 
     79      ! +1 open water diffusion 
     80      isize = jpl*(ihdf_vars+nlay_i)+1 
     81      ALLOCATE( zconv (isize) ) 
     82      ALLOCATE( pt2d_array(isize) , zrlx_array(isize) ) 
     83      ALLOCATE( type_array(isize) ) 
     84      ALLOCATE( psgn_array(isize) ) 
    6785       
    68       CALL wrk_alloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 
    69  
    70       !                       !==  Initialisation  ==! 
     86      CALL wrk_alloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 
     87      CALL wrk_alloc( jpi, jpj, zflu, zflv, zdiv ) 
     88 
     89      DO jk= 1 , isize 
     90         pt2d_array(jk)%pt2d=>ptab(:,:,jk) 
     91         zrlx_array(jk)%pt2d=>zrlx(:,:,jk) 
     92         type_array(jk)='T' 
     93         psgn_array(jk)=1. 
     94      END DO 
     95 
    7196      ! 
    7297      IF( linit ) THEN              ! Metric coefficient (compute at the first call and saved in efact) 
     
    7499         IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    75100         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' ) 
    76          DO jj = 2, jpjm1   
     101         DO jj = 2, jpjm1 
    77102            DO ji = fs_2 , fs_jpim1   ! vector opt. 
    78103               efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj) 
     
    83108      !                             ! Time integration parameters 
    84109      ! 
    85       ztab0(:, : ) = ptab(:,:)      ! Arrays initialization 
    86       zdiv0(:, 1 ) = 0._wp 
    87       zdiv0(:,jpj) = 0._wp 
    88       zflu (jpi,:) = 0._wp    
    89       zflv (jpi,:) = 0._wp 
    90       zdiv0(1,  :) = 0._wp 
    91       zdiv0(jpi,:) = 0._wp 
     110      zflu (jpi,: ) = 0._wp 
     111      zflv (jpi,: ) = 0._wp 
     112 
     113      DO jk=1 , isize 
     114         ztab0(:, : , jk ) = ptab(:,:,jk)      ! Arrays initialization 
     115         zdiv0(:, 1 , jk ) = 0._wp 
     116         zdiv0(:,jpj, jk ) = 0._wp 
     117         zdiv0(1,  :, jk ) = 0._wp 
     118         zdiv0(jpi,:, jk ) = 0._wp 
     119      END DO 
    92120 
    93121      zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==! 
    94122      iter  = 0 
    95123      ! 
    96       DO WHILE( zconv > ( 2._wp * 1.e-04 ) .AND. iter <= its )   ! Sub-time step loop 
     124      DO WHILE( MAXVAL(zconv(:)) > ( 2._wp * 1.e-04 ) .AND. iter <= its )   ! Sub-time step loop 
    97125         ! 
    98126         iter = iter + 1                                 ! incrementation of the sub-time step number 
    99127         ! 
     128         DO jk = 1 , isize 
     129            jl = (jk-1) /( ihdf_vars+nlay_i)+1 
     130            IF (zconv(jk) > ( 2._wp * 1.e-04 )) THEN 
     131               DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
     132                  DO ji = 1 , fs_jpim1   ! vector opt. 
     133                     zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) ) 
     134                     zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) ) 
     135                  END DO 
     136               END DO 
     137               ! 
     138               DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
     139                  DO ji = fs_2 , fs_jpim1   ! vector opt.  
     140                     zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
     141                  END DO 
     142               END DO 
     143               ! 
     144               IF( iter == 1 )   zdiv0(:,:,jk) = zdiv(:,:)        ! save the 1st evaluation of the diffusive trend in zdiv0 
     145               ! 
     146               DO jj = 2, jpjm1                                ! iterative evaluation 
     147                  DO ji = fs_2 , fs_jpim1   ! vector opt. 
     148                     zrlxint = (   ztab0(ji,jj,jk)    & 
     149                        &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj,jk) )   & 
     150                        &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj,jk) )                               & 
     151                        &      ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 
     152                     zrlx(ji,jj,jk) = ptab(ji,jj,jk) + zrelax * ( zrlxint - ptab(ji,jj,jk) ) 
     153                  END DO 
     154               END DO 
     155            END IF 
     156 
     157         END DO 
     158 
     159         CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 
     160         ! 
     161          
     162         IF ( MOD( iter-1 , nn_convfrq ) == 0 )  THEN   !Convergence test every nn_convfrq iterations (perf. optimization )  
     163            DO jk=1,isize 
     164               zconv(jk) = 0._wp                                   ! convergence test 
     165               DO jj = 2, jpjm1 
     166                  DO ji = fs_2, fs_jpim1 
     167                     zconv(jk) = MAX( zconv(jk), ABS( zrlx(ji,jj,jk) - ptab(ji,jj,jk) )  ) 
     168                  END DO 
     169               END DO 
     170            END DO 
     171            IF( lk_mpp ) CALL mpp_max_multiple( zconv , isize )            ! max over the global domain for all the variables 
     172         ENDIF 
     173         ! 
     174         DO jk=1,isize 
     175            ptab(:,:,jk) = zrlx(:,:,jk) 
     176         END DO 
     177         ! 
     178      END DO                                       ! end of sub-time step loop 
     179 
     180     ! ----------------------- 
     181      !!! final step (clem) !!! 
     182      DO jk = 1, isize 
     183         jl = (jk-1) /( ihdf_vars+nlay_i)+1 
    100184         DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    101185            DO ji = 1 , fs_jpim1   ! vector opt. 
    102                zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
    103                zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
     186               zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) ) 
     187               zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) ) 
    104188            END DO 
    105189         END DO 
     
    108192            DO ji = fs_2 , fs_jpim1   ! vector opt.  
    109193               zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
    110             END DO 
    111          END DO 
    112          ! 
    113          IF( iter == 1 )   zdiv0(:,:) = zdiv(:,:)        ! save the 1st evaluation of the diffusive trend in zdiv0 
    114          ! 
    115          DO jj = 2, jpjm1                                ! iterative evaluation 
    116             DO ji = fs_2 , fs_jpim1   ! vector opt. 
    117                zrlxint = (   ztab0(ji,jj)    & 
    118                   &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) )   & 
    119                   &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )                               &  
    120                   &      ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 
    121                zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) ) 
    122             END DO 
    123          END DO 
    124          CALL lbc_lnk( zrlx, 'T', 1. )                   ! lateral boundary condition 
    125          ! 
    126          IF ( MOD( iter, nn_convfrq ) == 0 )  THEN    ! convergence test every nn_convfrq iterations (perf. optimization) 
    127             zconv = 0._wp 
    128             DO jj = 2, jpjm1 
    129                DO ji = fs_2, fs_jpim1 
    130                   zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  ) 
    131                END DO 
    132             END DO 
    133             IF( lk_mpp )   CALL mpp_max( zconv )      ! max over the global domain 
    134          ENDIF 
    135          ! 
    136          ptab(:,:) = zrlx(:,:) 
    137          ! 
    138       END DO                                       ! end of sub-time step loop 
    139  
    140       ! ----------------------- 
    141       !!! final step (clem) !!! 
    142       DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
    143          DO ji = 1 , fs_jpim1   ! vector opt. 
    144             zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
    145             zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
     194               ptab(ji,jj,jk) = ztab0(ji,jj,jk) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj,jk) ) 
     195            END DO 
    146196         END DO 
    147197      END DO 
    148       ! 
    149       DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
    150          DO ji = fs_2 , fs_jpim1   ! vector opt.  
    151             zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj) 
    152             ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 
    153          END DO 
    154       END DO 
    155       CALL lbc_lnk( ptab, 'T', 1. )                   ! lateral boundary condition 
     198 
     199      CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 
     200 
    156201      !!! final step (clem) !!! 
    157202      ! ----------------------- 
    158203 
    159204      IF(ln_ctl)   THEN 
    160          zrlx(:,:) = ptab(:,:) - ztab0(:,:) 
    161          WRITE(charout,FMT="(' lim_hdf  : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 
    162          CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout ) 
    163       ENDIF 
    164       ! 
    165       CALL wrk_dealloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 
     205         DO jk = 1 , isize 
     206            zrlx(:,:,jk) = ptab(:,:,jk) - ztab0(:,:,jk) 
     207            WRITE(charout,FMT="(' lim_hdf  : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 
     208            CALL prt_ctl( tab2d_1=zrlx(:,:,jk), clinfo1=charout ) 
     209         END DO 
     210      ENDIF 
     211      ! 
     212      CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 
     213      CALL wrk_dealloc( jpi, jpj, zflu, zflv, zdiv ) 
     214 
     215      DEALLOCATE( zconv ) 
     216      DEALLOCATE( pt2d_array , zrlx_array ) 
     217      DEALLOCATE( type_array ) 
     218      DEALLOCATE( psgn_array ) 
    166219      ! 
    167220   END SUBROUTINE lim_hdf 
     221 
    168222 
    169223    
     
    179233      !!------------------------------------------------------------------- 
    180234      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    181       NAMELIST/namicehdf/ nn_convfrq 
     235      NAMELIST/namicehdf/ nn_convfrq  
    182236      !!------------------------------------------------------------------- 
    183237      ! 
     
    212266   !!====================================================================== 
    213267END MODULE limhdf 
     268 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r6795 r7993  
    2424   USE par_oce          ! ocean parameters 
    2525   USE dom_ice          ! sea-ice domain 
     26   USE limvar           ! lim_var_salprof 
    2627   USE in_out_manager   ! I/O manager 
    2728   USE lib_mpp          ! MPP library 
     
    327328         END DO 
    328329      END DO 
     330 
     331      ! for constant salinity in time 
     332      IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN 
     333         CALL lim_var_salprof 
     334         smv_i = sm_i * v_i 
     335      ENDIF 
    329336 
    330337      ! Snow temperature and heat content 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r6498 r7993  
    651651            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ij) * rhoic * r1_rdtice   ! increase in ice volume due to seawater frozen in voids 
    652652             
     653             ! virtual salt flux to keep salinity constant 
     654            IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN 
     655               srdg2(ij)      = srdg2(ij) - vsw(ij) * ( sss_m(ji,jj) - sm_i(ji,jj,jl1) )           ! ridge salinity = sm_i 
     656               sfx_bri(ji,jj) = sfx_bri(ji,jj) + sss_m(ji,jj)    * vsw(ij) * rhoic * r1_rdtice  &  ! put back sss_m into the ocean 
     657                  &                            - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice     ! and get  sm_i  from the ocean  
     658            ENDIF 
     659 
    653660            !------------------------------------------             
    654661            ! 3.7 Put the snow somewhere in the ocean 
     
    664671            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnowrdg )         &  
    665672               &                                - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice        ! heat sink for ocean (<0, W.m-2) 
    666  
     673                
    667674            !----------------------------------------------------------------- 
    668675            ! 3.8 Compute quantities used to apportion ice among categories 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r6498 r7993  
    116116 
    117117      ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 
    118       SELECT CASE( nn_icesal )                       ! varying salinity or not 
    119          CASE( 1, 3, 4 ) ;   zswitch_sal = 0       ! prescribed salinity profile 
    120          CASE( 2 )       ;   zswitch_sal = 1       ! varying salinity profile 
     118      SELECT CASE( nn_icesal )                  ! varying salinity or not 
     119         CASE( 1, 3 ) ;   zswitch_sal = 0       ! prescribed salinity profile 
     120         CASE( 2 )    ;   zswitch_sal = 1       ! varying salinity profile 
    121121      END SELECT 
    122122 
     
    651651 
    652652         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 
    653          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
    654653         zfmdt          = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp )    ! <0 
    655654         zsstK          = sst_m(ii,ij) + rt0                                 
     
    662661         ! Contribution to salt flux 
    663662         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice  
     663 
     664         ! virtual salt flux to keep salinity constant 
     665         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN 
     666            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt                  * r1_rdtice  & ! put back sss_m into the ocean 
     667               &                            - sm_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice    ! and get  sm_i  from the ocean  
     668         ENDIF 
    664669           
    665670         ! Contribution to mass flux 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r6486 r7993  
    6262      END DO 
    6363  
    64       !------------------------------------------------------------------------------| 
    65       ! 1) Constant salinity, constant in time                                       | 
    66       !------------------------------------------------------------------------------| 
    67 !!gm comment: if nn_icesal = 1 s_i_new, s_i_1d and sm_i_1d can be set to rn_icesal one for all in the initialisation phase !! 
    68 !!gm           ===>>>   simplification of almost all test on nn_icesal value 
    69       IF(  nn_icesal == 1  ) THEN 
    70             s_i_1d (kideb:kiut,1:nlay_i) =  rn_icesal 
    71             sm_i_1d(kideb:kiut)          =  rn_icesal  
    72             s_i_new(kideb:kiut)          =  rn_icesal 
    73       ENDIF 
     64      !--------------------------------------------------------------------| 
     65      ! 1) salinity constant in time                                       | 
     66      !--------------------------------------------------------------------| 
     67      ! do nothing 
    7468 
    75       !------------------------------------------------------------------------------| 
    76       !  Module 2 : Constant salinity varying in time                                | 
    77       !------------------------------------------------------------------------------| 
     69      !----------------------------------------------------------------------| 
     70      !  2) salinity varying in time                                         | 
     71      !----------------------------------------------------------------------| 
    7872      IF(  nn_icesal == 2  ) THEN 
    7973 
     
    113107 
    114108      !------------------------------------------------------------------------------| 
    115       !  Module 3 : Profile of salinity, constant in time                            | 
     109      !  3) vertical profile of salinity, constant in time                           | 
    116110      !------------------------------------------------------------------------------| 
    117111      IF(  nn_icesal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r6498 r7993  
    6363      INTEGER, INTENT(in) ::   kt           ! number of iteration 
    6464      ! 
    65       INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices 
     65      INTEGER  ::   ji, jj, jk, jm , jl, jt      ! dummy loop indices 
    6666      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    6767      REAL(wp) ::   zcfl , zusnit           !   -      - 
     
    7575      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax                   ! old ice thickness 
    7676      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold   ! old concentration, enthalpies 
     77      REAL(wp), POINTER, DIMENSION(:,:,:)             ::   zhdfptab 
    7778      REAL(wp) ::    zdv, zvi, zvs, zsmv, zes, zei 
    7879      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
     80      !!--------------------------------------------------------------------- 
     81      INTEGER                                ::  ihdf_vars  = 6  !!Number of variables in which we apply horizontal diffusion 
     82                                                                   !!  inside limtrp for each ice category , not counting the  
     83                                                                   !!  variables corresponding to ice_layers  
    7984      !!--------------------------------------------------------------------- 
    8085      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
     
    8590      CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 
    8691      CALL wrk_alloc( jpi,jpj,jpl,        zhimax, zviold, zvsold, zsmvold ) 
     92      CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1,zhdfptab) 
    8793 
    8894      IF( numit == nstart .AND. lwp ) THEN 
     
    170176            z0oi (:,:,jl)   = oa_i (:,:,jl) * e12t(:,:)    ! Age content 
    171177            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e12t(:,:)  ! Snow heat content 
    172             DO jk = 1, nlay_i 
     178           DO jk = 1, nlay_i 
    173179               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e12t(:,:) ! Ice  heat content 
    174180            END DO 
     
    284290         ! Diffusion of Ice fields                   
    285291         !------------------------------------------------------------------------------! 
    286  
     292         !------------------------------------ 
     293         !  Diffusion of other ice variables 
     294         !------------------------------------ 
     295         jm=1 
     296         DO jl = 1, jpl 
     297         !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points 
     298         !   DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
     299         !      DO ji = 1 , fs_jpim1   ! vector opt. 
     300         !         pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,jl) ) ) )   & 
     301         !            &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
     302         !         pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj  ,jl) ) ) )   & 
     303         !            &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
     304         !      END DO 
     305         !   END DO 
     306            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
     307               DO ji = 1 , fs_jpim1   ! vector opt. 
     308                  pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,  jl ) ) ) )   & 
     309                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,  jl ) ) ) ) * ahiu(ji,jj) 
     310                  pahv3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,  jj,  jl ) ) ) )   & 
     311                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,  jj+1,jl ) ) ) ) * ahiv(ji,jj) 
     312               END DO 
     313            END DO 
     314 
     315            zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1     
     316            zhdfptab(:,:,jm)= v_i  (:,:,  jl); jm = jm + 1 
     317            zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1  
     318            zhdfptab(:,:,jm)= smv_i(:,:,  jl); jm = jm + 1 
     319            zhdfptab(:,:,jm)= oa_i (:,:,  jl); jm = jm + 1 
     320            zhdfptab(:,:,jm)= e_s  (:,:,1,jl); jm = jm + 1 
     321         ! Sample of adding more variables to apply lim_hdf using lim_hdf optimization--- 
     322         !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1   
     323         !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1  
     324         ! 
     325         ! and in this example the parameter ihdf_vars musb be changed to 8 (necessary for allocation) 
     326         !---------------------------------------------------------------------------------------- 
     327            DO jk = 1, nlay_i 
     328              zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 
     329            END DO 
     330         END DO 
    287331         ! 
    288332         !-------------------------------- 
     
    290334         !-------------------------------- 
    291335         !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points 
     336         !DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
     337         !   DO ji = 1 , fs_jpim1   ! vector opt. 
     338         !      pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   & 
     339         !         &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 
     340         !      pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   & 
     341         !         &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 
     342         !   END DO 
     343         !END DO 
     344          
    292345         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    293346            DO ji = 1 , fs_jpim1   ! vector opt. 
    294                pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   & 
    295                   &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    296                pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   & 
    297                   &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 
     347               pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   & 
     348                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 
     349               pahv3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   & 
     350                  &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 
    298351            END DO 
    299352         END DO 
    300353         ! 
    301          CALL lim_hdf( ato_i (:,:) ) 
    302  
    303          !------------------------------------ 
    304          !  Diffusion of other ice variables 
    305          !------------------------------------ 
    306          DO jl = 1, jpl 
    307          !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points 
    308             DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    309                DO ji = 1 , fs_jpim1   ! vector opt. 
    310                   pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,jl) ) ) )   & 
    311                      &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
    312                   pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj  ,jl) ) ) )   & 
    313                      &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
    314                END DO 
    315             END DO 
    316  
    317             CALL lim_hdf( v_i  (:,:,  jl) ) 
    318             CALL lim_hdf( v_s  (:,:,  jl) ) 
    319             CALL lim_hdf( smv_i(:,:,  jl) ) 
    320             CALL lim_hdf( oa_i (:,:,  jl) ) 
    321             CALL lim_hdf( a_i  (:,:,  jl) ) 
    322             CALL lim_hdf( e_s  (:,:,1,jl) ) 
     354         zhdfptab(:,:,jm)= ato_i  (:,:); 
     355         CALL lim_hdf( zhdfptab, ihdf_vars, jpl, nlay_i)  
     356 
     357         jm=1 
     358         DO jl = 1, jpl 
     359            a_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1       
     360            v_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1  
     361            v_s  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1  
     362            smv_i(:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1  
     363            oa_i (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1  
     364            e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1  
     365         ! Sample of adding more variables to apply lim_hdf--------- 
     366         !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1  
     367         !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
     368         !----------------------------------------------------------- 
    323369            DO jk = 1, nlay_i 
    324                CALL lim_hdf( e_i(:,:,jk,jl) ) 
    325             END DO 
    326          END DO 
     370               e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1  
     371            END DO 
     372         END DO 
     373 
     374         ato_i  (:,:) = zhdfptab(:,:,jm) 
    327375 
    328376         !------------------------------------------------------------------------------! 
     
    464512      CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 
    465513      CALL wrk_dealloc( jpi,jpj,jpl,        zviold, zvsold, zhimax, zsmvold ) 
     514      CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars+nlay_i)+1,zhdfptab) 
    466515      ! 
    467516      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
     
    479528   !!====================================================================== 
    480529END MODULE limtrp 
     530 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r6498 r7993  
    314314      ! Vertically constant, constant in time 
    315315      !--------------------------------------- 
    316       IF(  nn_icesal == 1  )   s_i(:,:,:,:) = rn_icesal 
     316      IF(  nn_icesal == 1  )  THEN 
     317         s_i (:,:,:,:) = rn_icesal 
     318         sm_i(:,:,:)   = rn_icesal 
     319      ENDIF 
    317320 
    318321      !----------------------------------- 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90

    r7179 r7993  
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/OPA 3.4 , NEMO Consortium (2012) 
    40    !! $Id $ 
     40   !! $Id$ 
    4141   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r6486 r7993  
    1111   !!                            the BDY/OBC communications 
    1212   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add a C1D case   
     13   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi   
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_mpp_mpi 
     
    2425 
    2526   INTERFACE lbc_lnk_multi 
    26       MODULE PROCEDURE mpp_lnk_2d_9 
     27      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 
    2728   END INTERFACE 
    2829 
     
    8081   END INTERFACE 
    8182 
     83   INTERFACE lbc_lnk_multi 
     84      MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 
     85   END INTERFACE 
     86 
    8287   INTERFACE lbc_bdy_lnk 
    8388      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d 
     
    8792      MODULE PROCEDURE lbc_lnk_2d_e 
    8893   END INTERFACE 
     94    
     95   TYPE arrayptr 
     96      REAL , DIMENSION (:,:),  POINTER :: pt2d 
     97   END TYPE arrayptr 
     98   PUBLIC   arrayptr 
    8999 
    90100   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
    91101   PUBLIC   lbc_lnk_e  
     102   PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions 
    92103   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    93104   PUBLIC   lbc_lnk_icb 
     
    171182      ! 
    172183   END SUBROUTINE lbc_lnk_2d 
     184    
     185   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
     186      !! 
     187      INTEGER :: num_fields 
     188      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     189      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
     190      !                                                               ! = T , U , V , F , W and I points 
     191      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
     192      !                                                               ! =  1. , the sign is kept 
     193      ! 
     194      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
     195      ! 
     196      DO ii = 1, num_fields 
     197        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
     198      END DO      
     199      ! 
     200   END SUBROUTINE lbc_lnk_2d_multiple 
     201 
     202   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
     203      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
     204      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
     205      !!--------------------------------------------------------------------- 
     206      ! Second 2D array on which the boundary condition is applied 
     207      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
     208      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
     209      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
     210      ! define the nature of ptab array grid-points 
     211      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
     212      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
     213      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
     214      ! =-1 the sign change across the north fold boundary 
     215      REAL(wp)                                      , INTENT(in   ) ::   psgnA 
     216      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
     217      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
     218      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     219      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     220      !! 
     221      !!--------------------------------------------------------------------- 
     222 
     223      !!The first array 
     224      CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     225 
     226      !! Look if more arrays to process 
     227      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     228      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
     229      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
     230      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
     231      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
     232      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
     233      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
     234      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
     235 
     236   END SUBROUTINE lbc_lnk_2d_9 
     237 
     238 
     239 
     240 
    173241 
    174242#else 
     
    372440      !     
    373441   END SUBROUTINE lbc_lnk_2d 
     442    
     443   SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
     444      !! 
     445      INTEGER :: num_fields 
     446      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     447      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
     448      !                                                               ! = T , U , V , F , W and I points 
     449      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
     450      !                                                               ! =  1. , the sign is kept 
     451      ! 
     452      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
     453      ! 
     454      DO ii = 1, num_fields 
     455        CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
     456      END DO      
     457      ! 
     458   END SUBROUTINE lbc_lnk_2d_multiple 
     459 
     460   SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
     461      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
     462      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
     463      !!--------------------------------------------------------------------- 
     464      ! Second 2D array on which the boundary condition is applied 
     465      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
     466      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
     467      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
     468      ! define the nature of ptab array grid-points 
     469      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
     470      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
     471      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
     472      ! =-1 the sign change across the north fold boundary 
     473      REAL(wp)                                      , INTENT(in   ) ::   psgnA 
     474      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
     475      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
     476      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
     477      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     478      !! 
     479      !!--------------------------------------------------------------------- 
     480 
     481      !!The first array 
     482      CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     483 
     484      !! Look if more arrays to process 
     485      IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
     486      IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
     487      IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
     488      IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
     489      IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
     490      IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
     491      IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
     492      IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
     493 
     494   END SUBROUTINE lbc_lnk_2d_9 
     495 
    374496 
    375497#endif 
     
    441563   !!====================================================================== 
    442564END MODULE lbclnk 
     565 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r6487 r7993  
    2424   !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables  
    2525   !!            3.5  !  2013 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 
     26   !!            3.6  !  2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple'  
    2627   !!---------------------------------------------------------------------- 
    2728 
     
    6263   USE lbcnfd         ! north fold treatment 
    6364   USE in_out_manager ! I/O manager 
     65   USE wrk_nemo       ! work arrays 
    6466 
    6567   IMPLICIT NONE 
     
    7072   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e 
    7173   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
     74   PUBLIC   mpp_max_multiple 
    7275   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    73    PUBLIC   mpp_lnk_2d_9  
     76   PUBLIC   mpp_lnk_2d_9 , mpp_lnk_2d_multiple  
    7477   PUBLIC   mppscatter, mppgather 
    7578   PUBLIC   mpp_ini_ice, mpp_ini_znl 
     
    7881   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
    7982   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb 
     83   PUBLIC   mpprank 
    8084 
    8185   TYPE arrayptr 
    8286      REAL , DIMENSION (:,:),  POINTER :: pt2d 
    8387   END TYPE arrayptr 
     88   PUBLIC   arrayptr 
    8489    
    8590   !! * Interfaces 
     
    105110   INTERFACE mpp_maxloc 
    106111      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 
     112   END INTERFACE 
     113 
     114   INTERFACE mpp_max_multiple 
     115      MODULE PROCEDURE mppmax_real_multiple 
    107116   END INTERFACE 
    108117 
     
    732741      ! ----------------------- 
    733742      ! 
    734       DO ii = 1 , num_fields 
    735743         !First Array 
    736          IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    737             ! 
    738             SELECT CASE ( jpni ) 
    739             CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp 
    740             CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) )   ! for all northern procs. 
    741             END SELECT 
    742             ! 
    743          ENDIF 
    744          ! 
    745       END DO 
     744      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
     745         ! 
     746         SELECT CASE ( jpni ) 
     747         CASE ( 1 )     ;    
     748             DO ii = 1 , num_fields   
     749                       CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp 
     750             END DO 
     751         CASE DEFAULT   ;   CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields )   ! for all northern procs. 
     752         END SELECT 
     753         ! 
     754      ENDIF 
     755        ! 
    746756       
    747757      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
     
    16891699   END SUBROUTINE mppmax_real 
    16901700 
     1701   SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom  ) 
     1702      !!---------------------------------------------------------------------- 
     1703      !!                  ***  routine mppmax_real  *** 
     1704      !! 
     1705      !! ** Purpose :   Maximum 
     1706      !! 
     1707      !!---------------------------------------------------------------------- 
     1708      REAL(wp), DIMENSION(:) ,  INTENT(inout)           ::   ptab   ! ??? 
     1709      INTEGER , INTENT(in   )           ::   NUM 
     1710      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ??? 
     1711      !! 
     1712      INTEGER  ::   ierror, localcomm 
     1713      REAL(wp) , POINTER , DIMENSION(:) ::   zwork 
     1714      !!---------------------------------------------------------------------- 
     1715      ! 
     1716      CALL wrk_alloc(NUM , zwork) 
     1717      localcomm = mpi_comm_opa 
     1718      IF( PRESENT(kcom) )   localcomm = kcom 
     1719      ! 
     1720      CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror ) 
     1721      ptab = zwork 
     1722      CALL wrk_dealloc(NUM , zwork) 
     1723      ! 
     1724   END SUBROUTINE mppmax_real_multiple 
     1725 
    16911726 
    16921727   SUBROUTINE mppmin_a_real( ptab, kdim, kcom ) 
     
    25832618   END SUBROUTINE mpp_lbc_north_2d 
    25842619 
     2620   SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields) 
     2621      !!--------------------------------------------------------------------- 
     2622      !!                   ***  routine mpp_lbc_north_2d  *** 
     2623      !! 
     2624      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
     2625      !!              in mpp configuration in case of jpn1 > 1 
     2626      !!              (for multiple 2d arrays ) 
     2627      !! 
     2628      !! ** Method  :   North fold condition and mpp with more than one proc 
     2629      !!              in i-direction require a specific treatment. We gather 
     2630      !!              the 4 northern lines of the global domain on 1 processor 
     2631      !!              and apply lbc north-fold on this sub array. Then we 
     2632      !!              scatter the north fold array back to the processors. 
     2633      !! 
     2634      !!---------------------------------------------------------------------- 
     2635      INTEGER ,  INTENT (in   ) ::   num_fields  ! number of variables contained in pt2d 
     2636      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
     2637      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points 
     2638      !                                                          !   = T ,  U , V , F or W  gridpoints 
     2639      REAL(wp), DIMENSION(:), INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
     2640      !!                                                             ! =  1. , the sign is kept 
     2641      INTEGER ::   ji, jj, jr, jk 
     2642      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
     2643      INTEGER ::   ijpj, ijpjm1, ij, iproc 
     2644      INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather 
     2645      INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
     2646      INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
     2647      !                                                              ! Workspace for message transfers avoiding mpi_allgather 
     2648      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab 
     2649      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk 
     2650      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio 
     2651      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr 
     2652      INTEGER :: istatus(mpi_status_size) 
     2653      INTEGER :: iflag 
     2654      !!---------------------------------------------------------------------- 
     2655      ! 
     2656      ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), znorthgloio(jpi,4,num_fields,jpni) )   ! expanded to 3 dimensions 
     2657      ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) ) 
     2658      ! 
     2659      ijpj   = 4 
     2660      ijpjm1 = 3 
     2661      ! 
     2662       
     2663      DO jk = 1, num_fields 
     2664         DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d (for every variable) 
     2665            ij = jj - nlcj + ijpj 
     2666            znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj) 
     2667         END DO 
     2668      END DO 
     2669      !                                     ! Build in procs of ncomm_north the znorthgloio 
     2670      itaille = jpi * ijpj 
     2671                                                                   
     2672      IF ( l_north_nogather ) THEN 
     2673         ! 
     2674         ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
     2675         ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
     2676         ! 
     2677         ztabr(:,:,:) = 0 
     2678         ztabl(:,:,:) = 0 
     2679 
     2680         DO jk = 1, num_fields 
     2681            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
     2682               ij = jj - nlcj + ijpj 
     2683               DO ji = nfsloop, nfeloop 
     2684                  ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj) 
     2685               END DO 
     2686            END DO 
     2687         END DO 
     2688 
     2689         DO jr = 1,nsndto 
     2690            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2691               CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times 
     2692            ENDIF 
     2693         END DO 
     2694         DO jr = 1,nsndto 
     2695            iproc = nfipproc(isendto(jr),jpnj) 
     2696            IF(iproc .ne. -1) THEN 
     2697               ilei = nleit (iproc+1) 
     2698               ildi = nldit (iproc+1) 
     2699               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2700            ENDIF 
     2701            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2702              CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times 
     2703              DO jk = 1 , num_fields 
     2704                 DO jj = 1, ijpj 
     2705                    DO ji = ildi, ilei 
     2706                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)       ! Modified to 3D 
     2707                    END DO 
     2708                 END DO 
     2709              END DO 
     2710            ELSE IF (iproc .eq. (narea-1)) THEN 
     2711              DO jk = 1, num_fields 
     2712                 DO jj = 1, ijpj 
     2713                    DO ji = ildi, ilei 
     2714                          ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj)       ! Modified to 3D 
     2715                    END DO 
     2716                 END DO 
     2717              END DO 
     2718            ENDIF 
     2719         END DO 
     2720         IF (l_isend) THEN 
     2721            DO jr = 1,nsndto 
     2722               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2723                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2724               ENDIF 
     2725            END DO 
     2726         ENDIF 
     2727         ! 
     2728         DO ji = 1, num_fields     ! Loop to manage 3D variables 
     2729            CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) )  ! North fold boundary condition 
     2730         END DO 
     2731         ! 
     2732         DO jk = 1, num_fields 
     2733            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
     2734               ij = jj - nlcj + ijpj 
     2735               DO ji = 1, nlci 
     2736                  pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk)       ! Modified to 3D 
     2737               END DO 
     2738            END DO 
     2739         END DO 
     2740          
     2741         ! 
     2742      ELSE 
     2743         ! 
     2744         CALL MPI_ALLGATHER( znorthloc  , itaille*num_fields, MPI_DOUBLE_PRECISION,        & 
     2745            &                znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     2746         ! 
     2747         ztab(:,:,:) = 0.e0 
     2748         DO jk = 1, num_fields 
     2749            DO jr = 1, ndim_rank_north            ! recover the global north array 
     2750               iproc = nrank_north(jr) + 1 
     2751               ildi = nldit (iproc) 
     2752               ilei = nleit (iproc) 
     2753               iilb = nimppt(iproc) 
     2754               DO jj = 1, ijpj 
     2755                  DO ji = ildi, ilei 
     2756                     ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr) 
     2757                  END DO 
     2758               END DO 
     2759            END DO 
     2760         END DO 
     2761          
     2762         DO ji = 1, num_fields 
     2763            CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) )   ! North fold boundary condition 
     2764         END DO 
     2765         ! 
     2766         DO jk = 1, num_fields 
     2767            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
     2768               ij = jj - nlcj + ijpj 
     2769               DO ji = 1, nlci 
     2770                  pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk) 
     2771               END DO 
     2772            END DO 
     2773         END DO 
     2774         ! 
     2775         ! 
     2776      ENDIF 
     2777      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 
     2778      DEALLOCATE( ztabl, ztabr ) 
     2779      ! 
     2780   END SUBROUTINE mpp_lbc_north_2d_multiple 
    25852781 
    25862782   SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r6498 r7993  
    340340         emp_b(:,:) = emp(:,:) 
    341341         sfx_b(:,:) = sfx(:,:) 
     342         IF ( ln_rnf ) THEN 
     343            rnf_b    (:,:  ) = rnf    (:,:  ) 
     344            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
     345         ENDIF 
    342346      ENDIF 
    343347      !                                            ! ---------------------------------------- ! 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r6498 r7993  
    109109      ! 
    110110      CALL wrk_alloc( jpi,jpj, ztfrz) 
    111  
    112       !                                            ! ---------------------------------------- ! 
    113       IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
    114          !                                         ! ---------------------------------------- ! 
    115          rnf_b    (:,:  ) = rnf    (:,:  )               ! Swap the ocean forcing fields except at nit000 
    116          rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)               ! where before fields are set at the end of the routine 
    117          ! 
    118       ENDIF 
    119  
     111      ! 
    120112      !                                            !-------------------! 
    121113      !                                            !   Update runoff   ! 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r6793 r7993  
    12581258      ENDIF 
    12591259      ! 
     1260      ! Consistency check on ln_useCT and nn_eos 
     1261      IF ((nn_eos .EQ. -1) .AND. (.NOT. ln_useCT)) THEN 
     1262         CALL ctl_stop("ln_useCT should be set to True if using TEOS-10 (nn_eos=-1)") 
     1263      ELSE IF ((nn_eos .NE. -1) .AND. (ln_useCT)) THEN 
     1264         CALL ctl_stop("ln_useCT should be set to False if using TEOS-80 or simplified equation of state (nn_eos=0 or nn_eos=1)") 
     1265      ENDIF 
     1266      ! 
    12601267      SELECT CASE( nn_eos )         ! check option 
    12611268      ! 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r6793 r7993  
    279279         END DO   
    280280      ENDIF 
    281   
     281 
     282      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) )   ! runoff term on sst 
     283      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) )   ! runoff term on sss 
     284 
    282285      IF( l_trdtra )   THEN                      ! send trends for further diagnostics 
    283286         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/SETTE/sette.sh

    r6487 r7993  
    123123# Directory to run the tests 
    124124SETTE_DIR=$(cd $(dirname "$0"); pwd) 
    125 MAIN_DIR=${SETTE_DIR%/SETTE} 
     125MAIN_DIR=$(dirname $SETTE_DIR) 
    126126CONFIG_DIR=${MAIN_DIR}/CONFIG 
    127127TOOLS_DIR=${MAIN_DIR}/TOOLS 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py

    r6793 r7993  
    180180    if "units" in invar.ncattrs(): 
    181181        fo.variables[var].units = invar.units 
    182     os.remove(pathout.replace('.nc','_WORK.nc')) 
     182  os.remove(pathout.replace('.nc','_WORK.nc')) 
    183183# 
    184184add_k = 1 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/TOOLS/SIREN/README

    r5037 r7993  
    1 This is a first release of SIREN. 
    21 
    3 To create SIREN documentation, go to ./src and run doxygen  
     2To create SIREN documentation, run doxygen in TOOLS/SIREN directory 
    43(http://www.stack.nl/~dimitri/doxygen/index.html version 1.8.3.1 or upper) 
    54then 
    6    open ../doc/index.html  
     5   open ./TOOLS/SIREN/doc/html/index.html in your web browser  
    76or  
    8    run ../doc/latex/gmake and open refman.pdf  
    9  
    10  
    11 templates of namelists could be find in templates directory. 
    12 read documentation for more information. 
    13  
    14  1- program to create coordinate file : 
    15  
    16    ./create_coord create_coord.nam 
    17  
    18  
    19  Variables are extracted from the input coordinates coarse grid and 
    20  interpolated to create fine coordinates files. 
    21  
    22  2- program to create bathymetry file: 
    23  
    24  ./create_bathy create_bathy.nam 
    25  
    26  Bathymetry could be extracted from fine grid Bathymetry file, or 
    27  interpolated from coarse grid Bathymetry file. 
    28  
    29  3- program to merge bathymetry file at boundaries : 
    30  
    31  ./merge_bathy merge_bathy.nam 
    32  
    33  Coarse grid Bathymetry is interpolated on fine grid. 
    34  Then fine Bathymetry and refined coarse bathymetry are merged at 
    35  boundaries. 
    36  
    37  4- program to create restart file : 
    38  
    39  ./create_restart create_restart.nam 
    40  
    41  Variables are read from restart file, or standard output. 
    42  Then theses variables are interpolated on fine grid. 
    43  Finally table are split over new decomposition. 
    44  
    45  5- program to create boundary files (OBC) : 
    46  
    47  ./create_boundary create_boundary.nam 
    48  
    49  Variables are read from standard output. 
    50  Then theses variables are interpolated on fine grid boundaries. 
     7   run ./TOOLS/SIREN/doc/latex/gmake and open ./TOOLS/SIREN/doc/latex/refman.pdf  
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md

    r6487 r7993  
    1717<!--   - pgf95 (version 13.9-0) --> 
    1818 
    19  <HR> 
    20    <b> 
    21    - @ref index 
    22    - @ref md_docsrc_3_codingRules 
    23    - @ref md_docsrc_4_changeLog 
    24    - @ref todo 
    25    </b> 
     19# Fortran Compiler # 
     20SIREN codes were succesfully tested with : 
     21  - ifort (version 15.0.1) 
     22  - gfortran (version 4.8.2 20140120)  
     23 
     24<HR> 
     25  <b> 
     26  - @ref index 
     27  - @ref md_src_docsrc_2_quickstart 
     28  - @ref md_src_docsrc_3_support_bug 
     29  - @ref md_src_docsrc_4_codingRules 
     30  - @ref md_src_docsrc_5_changeLog 
     31  - @ref todo 
     32  </b> 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox

    r5037 r7993  
    1313   - create_boundary.f90 to create boundary condition from coarse grid standard outputs. 
    1414 
    15 To install those programs see @ref md_docsrc_1_install. 
     15 SIREN is a software to set up regional configuration with [NEMO](http://www.nemo-ocean.eu).<br/>  
     16 Actually SIREN creates the input files you need to run a NEMO regional configuration.<br/> 
     17  
     18 SIREN allows you to create your own regional configuration embedded in a wider one.<br/> 
    1619 
    17  @note SIREN can not: 
    18  - create global configuration 
    19  - create configuarion around or close to north pole 
    20  - change number of vertical level 
    21  - change grid (horizontal or vertical) 
     20 To know how to install SIREN see @ref md_src_docsrc_1_install. 
    2221 
    23  @section howto How to use 
    24    @subsection howto_coord to create fine grid coordinate file 
    25    see create_coord.f90 
    26    @subsection howto_bathy to create fine grid bathymetry 
    27    see create_bathy.f90 
    28    @subsection howto_merge to merge fine grid bathymetry 
    29    see merge_bathy.f90 
    30    @subsection howto_restart to create initial state file 
    31    see create_restart.f90 
    32    @subsection howto_boundary to create boundary condition 
    33    see create_boundary.f90 
     22 You could find a tutorial for a quick start with SIREN in @ref md_src_docsrc_2_quickstart.<br/> 
     23 For more information about how to use each component of SIREN 
     24 - see create_coord.f90 to create fine grid coordinate file 
     25 - see create_bathy.f90 to create fine grid bathymetry 
     26 - see merge_bathy.f90 to merge fine grid bathymetry 
     27 - see create_restart.f90 to create initial state file, or other fields. 
     28 - see create_boundary.F90 to create boundary condition 
    3429 
    3530<HR> 
    3631   <b> 
    37    - @ref md_docsrc_1_install 
    38    - @ref md_docsrc_3_codingRules 
    39    - @ref md_docsrc_4_changeLog 
     32   - @ref md_src_docsrc_1_install 
     33   - @ref md_src_docsrc_2_quickstart 
     34   - @ref md_src_docsrc_3_support_bug 
     35   - @ref md_src_docsrc_4_codingRules 
     36   - @ref md_src_docsrc_5_changeLog 
    4037   - @ref todo 
    4138   </b> 
Note: See TracChangeset for help on using the changeset viewer.