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

Changeset 2804


Ignore:
Timestamp:
2011-07-18T17:05:52+02:00 (13 years ago)
Author:
rblod
Message:

dev_r2802_LOCEAN10_agrif_lim: first implementation see ticket #848

Location:
branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO
Files:
3 added
12 edited

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r2715 r2804  
    117117 
    118118   !!* moment used in the advection scheme 
    119    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxice, syice, sxxice, syyice, sxyice   !: for ice  volume 
    120    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxsn,  sysn,  sxxsn,  syysn,  sxysn    !: for snow volume                   
    121    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxa,   sya,   sxxa,   syya,   sxya     !: for ice cover area                
    122    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc0,  syc0,  sxxc0,  syyc0,  sxyc0    !: for heat content of snow          
    123    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc1,  syc1,  sxxc1,  syyc1,  sxyc1    !: for heat content of 1st ice layer 
    124    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer 
    125    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s0ice, sxice, syice, sxxice, syyice, sxyice   !: for ice  volume 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s0sn , sxsn,  sysn,  sxxsn,  syysn,  sxysn    !: for snow volume                   
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s0a  , sxa,   sya,   sxxa,   syya,   sxya     !: for ice cover area                
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s0c0 , sxc0,  syc0,  sxxc0,  syyc0,  sxyc0    !: for heat content of snow          
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s0c1 , sxc1,  syc1,  sxxc1,  syyc1,  sxyc1    !: for heat content of 1st ice layer 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s0c2 , sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s0st , sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets 
     126 
    126127   !!---------------------------------------------------------------------- 
    127128   CONTAINS 
    … …  
    164165 
    165166      !* moment used in the advection scheme 
    166       ALLOCATE(sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) ,     & 
     167      ALLOCATE(s0ice (jpi,jpj) , sxice (jpi,jpj) , syice (jpi,jpj) , sxxice(jpi,jpj) ,     & 
    167168         &     syyice(jpi,jpj) , sxyice(jpi,jpj) ,                       & 
    168          &     sxsn  (jpi,jpj) , sysn  (jpi,jpj) , sxxsn (jpi,jpj) ,     & 
     169         &     s0sn  (jpi,jpj) , sxsn  (jpi,jpj) , sysn  (jpi,jpj) , sxxsn (jpi,jpj) ,     & 
    169170         &     syysn (jpi,jpj) , sxysn (jpi,jpj)                   , STAT=ierr(6) ) 
    170       ALLOCATE(sxa   (jpi,jpj) , sya   (jpi,jpj) , sxxa  (jpi,jpj) ,     & 
     171      ALLOCATE(s0a   (jpi,jpj) , sxa   (jpi,jpj) , sya   (jpi,jpj) , sxxa  (jpi,jpj) ,     & 
    171172         &     syya  (jpi,jpj) , sxya  (jpi,jpj) ,                       &  
    172          &     sxc0  (jpi,jpj) , syc0  (jpi,jpj) , sxxc0 (jpi,jpj) ,     & 
     173         &     s0c0  (jpi,jpj) , sxc0  (jpi,jpj) , syc0  (jpi,jpj) , sxxc0 (jpi,jpj) ,     & 
    173174         &     syyc0 (jpi,jpj) , sxyc0 (jpi,jpj)                   , STAT=ierr(7)) 
    174       ALLOCATE(sxc1  (jpi,jpj) , syc1  (jpi,jpj) , sxxc1 (jpi,jpj) ,     & 
     175      ALLOCATE(s0c1  (jpi,jpj) , sxc1  (jpi,jpj) , syc1  (jpi,jpj) , sxxc1 (jpi,jpj) ,     & 
    175176         &     syyc1 (jpi,jpj) , sxyc1 (jpi,jpj) ,                       & 
    176          &     sxc2  (jpi,jpj) , syc2  (jpi,jpj) , sxxc2 (jpi,jpj) ,     & 
     177         &     s0c2  (jpi,jpj) , sxc2  (jpi,jpj) , syc2  (jpi,jpj) , sxxc2 (jpi,jpj) ,     & 
    177178         &     syyc2 (jpi,jpj) , sxyc2 (jpi,jpj)                   , STAT=ierr(8)) 
    178       ALLOCATE(sxst  (jpi,jpj) , syst  (jpi,jpj) , sxxst (jpi,jpj) ,     & 
     179      ALLOCATE(s0st  (jpi,jpj) , sxst  (jpi,jpj) , syst  (jpi,jpj) , sxxst (jpi,jpj) ,     & 
    179180         &     syyst (jpi,jpj) , sxyst (jpi,jpj)                   , STAT=ierr(9)) 
    180181         ! 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

    r2730 r2804  
    2323   USE par_ice_2        ! LIM2 parameters 
    2424   USE thd_ice_2        ! LIM2 thermodynamical variables 
    25    USE limrhg           ! LIM2 rheology 
     25   USE limrhg           ! LIM2 EVP rheology 
     26   USE limrhg_2         ! LIM2 VP rheology 
    2627   USE ice_2            ! LIM2 ice variable 
    2728   USE limmsh_2         ! LIM2 mesh 
    … …  
    6566#if ! defined key_lim2_vp 
    6667      ierr = ierr + lim_rhg_alloc  () 
     68#else 
     69      ierr = ierr + lim_rhg_alloc_2()       
    6770#endif 
    6871      IF( lk_mpp    )   CALL mpp_sum( ierr ) 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90

    r2715 r2804  
    6060      !!-------------------------------------------------------------------- 
    6161      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    62       USE wrk_nemo, ONLY:   zf0  => wrk_2d_11 , zfx   => wrk_2d_12 , zfy    => wrk_2d_13 , zbet => wrk_2d_14   ! 2D workspace 
    63       USE wrk_nemo, ONLY:   zfm  => wrk_2d_15 , zfxx  => wrk_2d_16 , zfyy   => wrk_2d_17 , zfxy => wrk_2d_18   !  -      - 
    64       USE wrk_nemo, ONLY:   zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21                       !  -      - 
     62      USE wrk_nemo, ONLY:   zf0  => wrk_2d_18 , zfx   => wrk_2d_19 , zfy    => wrk_2d_20 , zbet => wrk_2d_21   ! 2D workspace 
     63      USE wrk_nemo, ONLY:   zfm  => wrk_2d_22 , zfxx  => wrk_2d_23 , zfyy   => wrk_2d_24 , zfxy => wrk_2d_25   !  -      - 
     64      USE wrk_nemo, ONLY:   zalg => wrk_2d_26 , zalg1 => wrk_2d_27 , zalg1q => wrk_2d_28                       !  -      - 
    6565      ! 
    6666      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    … …  
    7878      !--------------------------------------------------------------------- 
    7979 
    80       IF( wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 
     80      IF( wrk_in_use(2, 18,19,20,21,22,23,24,25,26,27,28) ) THEN 
    8181         CALL ctl_stop( 'lim_adv_x_2 : requested workspace arrays unavailable.' )   ;   RETURN 
    8282      ENDIF 
    … …  
    225225      ENDIF 
    226226      ! 
    227       IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) )   & 
     227      IF( wrk_not_released(2, 18,19,20,21,22,23,24,25,26,27,28) )   & 
    228228          CALL ctl_stop( 'lim_adv_x_2 : failed to release workspace arrays.' ) 
    229229      ! 
    … …  
    246246      !!--------------------------------------------------------------------- 
    247247      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    248       USE wrk_nemo, ONLY:   zf0  => wrk_2d_11 , zfx   => wrk_2d_12 , zfy    => wrk_2d_13 , zbet => wrk_2d_14   ! 2D workspace 
    249       USE wrk_nemo, ONLY:   zfm  => wrk_2d_15 , zfxx  => wrk_2d_16 , zfyy   => wrk_2d_17 , zfxy => wrk_2d_18   !  -      - 
    250       USE wrk_nemo, ONLY:   zalg => wrk_2d_19 , zalg1 => wrk_2d_20 , zalg1q => wrk_2d_21                       !  -      - 
     248      USE wrk_nemo, ONLY:   zf0  => wrk_2d_18 , zfx   => wrk_2d_19 , zfy    => wrk_2d_20 , zbet => wrk_2d_21   ! 2D workspace 
     249      USE wrk_nemo, ONLY:   zfm  => wrk_2d_22 , zfxx  => wrk_2d_23 , zfyy   => wrk_2d_24 , zfxy => wrk_2d_25   !  -      - 
     250      USE wrk_nemo, ONLY:   zalg => wrk_2d_26 , zalg1 => wrk_2d_27 , zalg1q => wrk_2d_28                       !  -      - 
    251251      !! 
    252252      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    … …  
    264264      !--------------------------------------------------------------------- 
    265265 
    266       IF(wrk_in_use(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 
     266      IF( wrk_in_use(2, 18,19,20,21,22,23,24,25,26,27,28) ) THEN 
    267267         CALL ctl_stop( 'lim_adv_y_2 : requested workspace arrays unavailable.' )   ;   RETURN 
    268       END IF 
     268      ENDIF 
    269269 
    270270      ! Limitation of moments. 
    … …  
    414414      ENDIF 
    415415      ! 
    416       IF( wrk_not_released(2, 11,12,13,14,15,16,17,18,19,20,21) ) THEN 
    417         CALL ctl_stop( 'lim_adv_y_2 : failed to release workspace arrays.' ) 
    418       END IF 
     416      IF( wrk_not_released(2, 18,19,20,21,22,23,24,25,26,27,28) )   & 
     417          CALL ctl_stop( 'lim_adv_y_2 : failed to release workspace arrays.' ) 
    419418      ! 
    420419   END SUBROUTINE lim_adv_y_2 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

    r2715 r2804  
    5252      !!------------------------------------------------------------------- 
    5353      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    54       USE wrk_nemo, ONLY:   zflu => wrk_2d_11, zdiv  => wrk_2d_13, zrlx  => wrk_2d_15  
    55       USE wrk_nemo, ONLY:   zflv => wrk_2d_12, zdiv0 => wrk_2d_14, ztab0 => wrk_2d_16 
     54      USE wrk_nemo, ONLY:   zflu => wrk_2d_17, zdiv  => wrk_2d_18, zrlx  => wrk_2d_19  
     55      USE wrk_nemo, ONLY:   zflv => wrk_2d_20, zdiv0 => wrk_2d_21, ztab0 => wrk_2d_22 
    5656      ! 
    5757      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   ptab   ! Field on which the diffusion is applied   
    … …  
    6363      !!------------------------------------------------------------------- 
    6464 
    65       IF( wrk_in_use(2, 11,12,13,14,15,16) ) THEN 
     65      IF( wrk_in_use(2, 17,18,19,20,21,22) ) THEN 
    6666         CALL ctl_stop( 'lim_hdf_2 : requested workspace arrays unavailable.' )   ;   RETURN 
    6767      END IF 
    … …  
    149149      ENDIF 
    150150      ! 
    151       IF( wrk_not_released(2, 11,12,13,14,15,16) )   CALL ctl_stop('lim_hdf_2: failed to release workspace arrays') 
     151      IF( wrk_not_released(2, 17,18,19,20,21,22) )   CALL ctl_stop('lim_hdf_2: failed to release workspace arrays') 
    152152      ! 
    153153   END SUBROUTINE lim_hdf_2 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    r2715 r2804  
    2929   USE in_out_manager ! I/O manager 
    3030   USE prtctl         ! Print control 
     31#if defined key_agrif 
     32   USE agrif_lim2_interp ! nesting 
     33#endif 
    3134 
    3235   IMPLICIT NONE 
    … …  
    147150!i    zviszeta(:,jpj+1) = 0._wp    ;    zviseta(:,jpj+1) = 0._wp 
    148151 
     152#if defined key_agrif 
     153      ! load the boundary value of velocity in special array zuive and zvice 
     154      CALL Agrif_dyn_lim2_load 
     155#endif 
    149156 
    150157      ! Ice mass, ice strength, and wind stress at the center            | 
    … …  
    551558            CALL lbc_lnk( zv_n(:,1:jpj), 'I', -1. ) 
    552559 
     560#if defined key_agrif 
     561            ! copy the boundary value from u_ice_nst and v_ice_nst to u_ice and v_ice 
     562            ! before next interations 
     563            CALL Agrif_dyn_lim2_copy(zu_n,zv_n) 
     564#endif 
     565 
    553566            ! Test of Convergence 
    554567            DO jj = k_j1+1 , k_jpj-1 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

    r2715 r2804  
    2828   USE lib_mpp         ! MPP library 
    2929 
     30# if defined key_agrif 
     31   USE agrif_lim2_interp ! nesting 
     32# endif 
     33 
    3034   IMPLICIT NONE 
    3135   PRIVATE 
    … …  
    6468      !!--------------------------------------------------------------------- 
    6569      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY: zui_u  => wrk_2d_1, zvi_v => wrk_2d_2, zsm  => wrk_2d_3 
    67       USE wrk_nemo, ONLY: zs0ice => wrk_2d_4, zs0sn => wrk_2d_5, zs0a => wrk_2d_6 
    68       USE wrk_nemo, ONLY: zs0c0 => wrk_2d_7,  zs0c1 => wrk_2d_8, zs0c2 => wrk_2d_9, & 
    69                           zs0st => wrk_2d_10 
     70      USE wrk_nemo, ONLY: zui_u  => wrk_2d_1, zvi_v => wrk_2d_2 
     71      USE wrk_nemo, ONLY: zsmice => wrk_2d_3, zsmsn => wrk_2d_4, zsma => wrk_2d_5 
     72      USE wrk_nemo, ONLY: zsmc0 => wrk_2d_6,  zsmc1 => wrk_2d_7, zsmc2 => wrk_2d_8, & 
     73                          zsmst => wrk_2d_9 
    7074      !! 
    7175      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    … …  
    7983      !--------------------------------------------------------------------- 
    8084 
    81       IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10) ) THEN 
     85      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9) ) THEN 
    8286         CALL ctl_stop('lim_trp_2 : requested workspace arrays unavailable')   ;   RETURN 
    8387      ENDIF 
    … …  
    8589      IF( kt == nit000  )   CALL lim_trp_init_2      ! Initialization (first time-step only) 
    8690 
    87       zsm(:,:) = area(:,:) 
    88        
     91      zsmice(:,:) = area(:,:) 
     92      zsmsn (:,:) = area(:,:) 
     93      zsma  (:,:) = area(:,:) 
     94      zsmc0 (:,:) = area(:,:) 
     95      zsmc1 (:,:) = area(:,:) 
     96      zsmc2 (:,:) = area(:,:) 
     97      zsmst (:,:) = area(:,:) 
     98      
    8999      IF( ln_limdyn ) THEN 
    90100         !-------------------------------------! 
    … …  
    121131         ! content of properties 
    122132         ! --------------------- 
    123          zs0sn (:,:) =  hsnm(:,:)              * area  (:,:)  ! Snow volume. 
    124          zs0ice(:,:) =  hicm(:,:)              * area  (:,:)  ! Ice volume. 
    125          zs0a  (:,:) =  ( 1.0 - frld(:,:) )    * area  (:,:)  ! Surface covered by ice. 
    126          zs0c0 (:,:) =  tbif(:,:,1) / rt0_snow * zs0sn (:,:)  ! Heat content of the snow layer. 
    127          zs0c1 (:,:) =  tbif(:,:,2) / rt0_ice  * zs0ice(:,:)  ! Heat content of the first ice layer. 
    128          zs0c2 (:,:) =  tbif(:,:,3) / rt0_ice  * zs0ice(:,:)  ! Heat content of the second ice layer. 
    129          zs0st (:,:) =  qstoif(:,:) / xlic     * zs0a  (:,:)  ! Heat reservoir for brine pockets. 
     133         s0sn (:,:) =  hsnm(:,:)              * area  (:,:)  ! Snow volume. 
     134         s0ice(:,:) =  hicm(:,:)              * area  (:,:)  ! Ice volume. 
     135         s0a  (:,:) =  ( 1.0 - frld(:,:) )    * area  (:,:)  ! Surface covered by ice. 
     136         s0c0 (:,:) =  tbif(:,:,1) / rt0_snow * s0sn (:,:)  ! Heat content of the snow layer. 
     137         s0c1 (:,:) =  tbif(:,:,2) / rt0_ice  * s0ice(:,:)  ! Heat content of the first ice layer. 
     138         s0c2 (:,:) =  tbif(:,:,3) / rt0_ice  * s0ice(:,:)  ! Heat content of the second ice layer. 
     139         s0st (:,:) =  qstoif(:,:) / xlic     * s0a  (:,:)  ! Heat reservoir for brine pockets. 
    130140          
    131141  
    … …  
    137147         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0) THEN        !==  odd ice time step:  adv_x then adv_y  ==! 
    138148            DO jk = 1, initad 
    139                CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
    140                CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
    141                CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  ) 
    142                CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  ) 
    143                CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   ) 
    144                CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   ) 
    145                CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  ) 
    146                CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  ) 
    147                CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  ) 
    148                CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  ) 
    149                CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  ) 
    150                CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  ) 
    151                CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  ) 
    152                CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  ) 
     149               CALL lim_adv_x_2( zusnit, zui_u, rone , zsmice, s0ice, sxice, sxxice, syice, syyice, sxyice ) 
     150               CALL lim_adv_x_2( zusnit, zui_u, rone , zsmsn , s0sn , sxsn , sxxsn , sysn , syysn , sxysn  ) 
     151               CALL lim_adv_x_2( zusnit, zui_u, rone , zsma  , s0a  , sxa  , sxxa  , sya  , syya  , sxya   ) 
     152               CALL lim_adv_x_2( zusnit, zui_u, rone , zsmc0 , s0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  ) 
     153               CALL lim_adv_x_2( zusnit, zui_u, rone , zsmc1 , s0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  ) 
     154               CALL lim_adv_x_2( zusnit, zui_u, rone , zsmc2 , s0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  ) 
     155               CALL lim_adv_x_2( zusnit, zui_u, rone , zsmst , s0st , sxst , sxxst , syst , syyst , sxyst  ) 
     156# if defined key_agrif 
     157               CALL Agrif_sadv_lim2(kt) 
     158# endif 
     159               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsmice, s0ice, sxice, sxxice, syice, syyice, sxyice ) 
     160               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsmsn , s0sn , sxsn , sxxsn , sysn , syysn , sxysn  ) 
     161               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsma  , s0a  , sxa  , sxxa  , sya  , syya  , sxya   ) 
     162               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsmc0 , s0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  ) 
     163               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsmc1 , s0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  ) 
     164               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsmc2 , s0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  ) 
     165               CALL lim_adv_y_2( zusnit, zvi_v, rzero, zsmst , s0st , sxst , sxxst , syst , syyst , sxyst  ) 
     166# if defined key_agrif 
     167               CALL Agrif_sadv_lim2(kt) 
     168# endif 
    153169            END DO 
    154170         ELSE                                                 !==  even ice time step:  adv_x then adv_y  ==! 
    155171            DO jk = 1, initad 
    156                CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
    157                CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
    158                CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  ) 
    159                CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  ) 
    160                CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   ) 
    161                CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   ) 
    162                CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  ) 
    163                CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  ) 
    164                CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  ) 
    165                CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  ) 
    166                CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  ) 
    167                CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  ) 
    168                CALL lim_adv_y_2( zusnit, zvi_v, rone , zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  ) 
    169                CALL lim_adv_x_2( zusnit, zui_u, rzero, zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  ) 
     172               CALL lim_adv_y_2( zusnit, zvi_v, rone, zsmice, s0ice, sxice, sxxice, syice, syyice, sxyice ) 
     173               CALL lim_adv_y_2( zusnit, zvi_v, rone, zsmsn , s0sn , sxsn , sxxsn , sysn , syysn , sxysn  ) 
     174               CALL lim_adv_y_2( zusnit, zvi_v, rone, zsma  , s0a  , sxa  , sxxa  , sya  , syya  , sxya   ) 
     175               CALL lim_adv_y_2( zusnit, zvi_v, rone, zsmc0 , s0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  ) 
     176               CALL lim_adv_y_2( zusnit, zvi_v, rone, zsmc1 , s0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  ) 
     177               CALL lim_adv_y_2( zusnit, zvi_v, rone, zsmc2 , s0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  ) 
     178               CALL lim_adv_y_2( zusnit, zvi_v, rone, zsmst , s0st , sxst , sxxst , syst , syyst , sxyst  ) 
     179# if defined key_agrif 
     180               CALL Agrif_sadv_lim2(kt) 
     181# endif 
     182               CALL lim_adv_x_2( zusnit, zui_u, rzero , zsmice, s0ice, sxice, sxxice, syice, syyice, sxyice ) 
     183               CALL lim_adv_x_2( zusnit, zui_u, rzero , zsmsn , s0sn , sxsn , sxxsn , sysn , syysn , sxysn  ) 
     184               CALL lim_adv_x_2( zusnit, zui_u, rzero , zsma  , s0a  , sxa  , sxxa  , sya  , syya  , sxya   ) 
     185               CALL lim_adv_x_2( zusnit, zui_u, rzero , zsmc0 , s0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  ) 
     186               CALL lim_adv_x_2( zusnit, zui_u, rzero , zsmc1 , s0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  ) 
     187               CALL lim_adv_x_2( zusnit, zui_u, rzero , zsmc2 , s0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  ) 
     188               CALL lim_adv_x_2( zusnit, zui_u, rzero , zsmst , s0st , sxst , sxxst , syst , syyst , sxyst  ) 
     189# if defined key_agrif 
     190               CALL Agrif_sadv_lim2(kt) 
     191# endif 
    170192            END DO 
    171193         ENDIF 
    … …  
    174196         ! ------------------------------------------ 
    175197!!gm Define in limmsh one for all area = 1 /area  (CPU time saved !) 
    176          zs0ice(:,:) = zs0ice(:,:) / area(:,:) 
    177          zs0sn (:,:) = zs0sn (:,:) / area(:,:) 
    178          zs0a  (:,:) = zs0a  (:,:) / area(:,:) 
    179          zs0c0 (:,:) = zs0c0 (:,:) / area(:,:) 
    180          zs0c1 (:,:) = zs0c1 (:,:) / area(:,:) 
    181          zs0c2 (:,:) = zs0c2 (:,:) / area(:,:) 
    182          zs0st (:,:) = zs0st (:,:) / area(:,:) 
     198         s0ice(:,:) = s0ice(:,:) / area(:,:) 
     199         s0sn (:,:) = s0sn (:,:) / area(:,:) 
     200         s0a  (:,:) = s0a  (:,:) / area(:,:) 
     201         s0c0 (:,:) = s0c0 (:,:) / area(:,:) 
     202         s0c1 (:,:) = s0c1 (:,:) / area(:,:) 
     203         s0c2 (:,:) = s0c2 (:,:) / area(:,:) 
     204         s0st (:,:) = s0st (:,:) / area(:,:) 
    183205 
    184206 
    … …  
    191213         DO jj = 1, jpjm1          ! NB: has not to be defined on jpj line and jpi row 
    192214            DO ji = 1 , fs_jpim1   ! vector opt. 
    193                pahu(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji  ,jj) ) ) )   & 
    194                   &        * ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    195                pahv(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji,jj  ) ) ) )   & 
    196                   &        * ( 1.0 - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1) ) ) ) * ahiv(ji,jj) 
     215               pahu(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -s0a(ji  ,jj) ) ) )   & 
     216                  &        * ( 1.0 - MAX( rzero, SIGN( rone, -s0a(ji+1,jj) ) ) ) * ahiu(ji,jj) 
     217               pahv(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -s0a(ji,jj  ) ) ) )   & 
     218                  &        * ( 1.0 - MAX( rzero, SIGN( rone,- s0a(ji,jj+1) ) ) ) * ahiv(ji,jj) 
    197219            END DO 
    198220         END DO 
    … …  
    200222!        DO jj = 1, jpjm1          ! NB: has not to be defined on jpj line and jpi row 
    201223!           DO ji = 1 , fs_jpim1   ! vector opt. 
    202 !              IF( MIN( zs0a(ji,jj) , zs0a(ji+1,jj) ) == 0.e0 )   pahu(ji,jj) = 0._wp 
    203 !              IF( MIN( zs0a(ji,jj) , zs0a(ji,jj+1) ) == 0.e0 )   pahv(ji,jj) = 0._wp 
     224!              IF( MIN( s0a(ji,jj) , s0a(ji+1,jj) ) == 0.e0 )   pahu(ji,jj) = 0._wp 
     225!              IF( MIN( s0a(ji,jj) , s0a(ji,jj+1) ) == 0.e0 )   pahv(ji,jj) = 0._wp 
    204226!           END DO 
    205227!        END DO 
    … …  
    208230         ! diffusion 
    209231         ! --------- 
    210          CALL lim_hdf_2( zs0ice ) 
    211          CALL lim_hdf_2( zs0sn  ) 
    212          CALL lim_hdf_2( zs0a   ) 
    213          CALL lim_hdf_2( zs0c0  ) 
    214          CALL lim_hdf_2( zs0c1  ) 
    215          CALL lim_hdf_2( zs0c2  ) 
    216          CALL lim_hdf_2( zs0st  ) 
     232         CALL lim_hdf_2( s0ice ) 
     233         CALL lim_hdf_2( s0sn  ) 
     234         CALL lim_hdf_2( s0a   ) 
     235         CALL lim_hdf_2( s0c0  ) 
     236         CALL lim_hdf_2( s0c1  ) 
     237         CALL lim_hdf_2( s0c2  ) 
     238         CALL lim_hdf_2( s0st  ) 
    217239 
    218240!!gm see comment this can be skipped 
    219          zs0ice(:,:) = MAX( rzero, zs0ice(:,:) * area(:,:) )    !!bug:  useless 
    220          zs0sn (:,:) = MAX( rzero, zs0sn (:,:) * area(:,:) )    !!bug:  cf /area  just below 
    221          zs0a  (:,:) = MAX( rzero, zs0a  (:,:) * area(:,:) )    !! caution: the suppression of the 2 changes  
    222          zs0c0 (:,:) = MAX( rzero, zs0c0 (:,:) * area(:,:) )    !! the last digit of the results 
    223          zs0c1 (:,:) = MAX( rzero, zs0c1 (:,:) * area(:,:) ) 
    224          zs0c2 (:,:) = MAX( rzero, zs0c2 (:,:) * area(:,:) ) 
    225          zs0st (:,:) = MAX( rzero, zs0st (:,:) * area(:,:) ) 
     241         s0ice(:,:) = MAX( rzero, s0ice(:,:) * area(:,:) )    !!bug:  useless 
     242         s0sn (:,:) = MAX( rzero, s0sn (:,:) * area(:,:) )    !!bug:  cf /area  just below 
     243         s0a  (:,:) = MAX( rzero, s0a  (:,:) * area(:,:) )    !! caution: the suppression of the 2 changes  
     244         s0c0 (:,:) = MAX( rzero, s0c0 (:,:) * area(:,:) )    !! the last digit of the results 
     245         s0c1 (:,:) = MAX( rzero, s0c1 (:,:) * area(:,:) ) 
     246         s0c2 (:,:) = MAX( rzero, s0c2 (:,:) * area(:,:) ) 
     247         s0st (:,:) = MAX( rzero, s0st (:,:) * area(:,:) ) 
    226248 
    227249 
    … …  
    234256               ! 
    235257               ! Recover mean values over the grid squares. 
    236                zs0sn (ji,jj) = MAX( rzero, zs0sn (ji,jj)/area(ji,jj) ) 
    237                zs0ice(ji,jj) = MAX( rzero, zs0ice(ji,jj)/area(ji,jj) ) 
    238                zs0a  (ji,jj) = MAX( rzero, zs0a  (ji,jj)/area(ji,jj) ) 
    239                zs0c0 (ji,jj) = MAX( rzero, zs0c0 (ji,jj)/area(ji,jj) ) 
    240                zs0c1 (ji,jj) = MAX( rzero, zs0c1 (ji,jj)/area(ji,jj) ) 
    241                zs0c2 (ji,jj) = MAX( rzero, zs0c2 (ji,jj)/area(ji,jj) ) 
    242                zs0st (ji,jj) = MAX( rzero, zs0st (ji,jj)/area(ji,jj) ) 
     258               s0sn (ji,jj) = MAX( rzero, s0sn (ji,jj)/area(ji,jj) ) 
     259               s0ice(ji,jj) = MAX( rzero, s0ice(ji,jj)/area(ji,jj) ) 
     260               s0a  (ji,jj) = MAX( rzero, s0a  (ji,jj)/area(ji,jj) ) 
     261               s0c0 (ji,jj) = MAX( rzero, s0c0 (ji,jj)/area(ji,jj) ) 
     262               s0c1 (ji,jj) = MAX( rzero, s0c1 (ji,jj)/area(ji,jj) ) 
     263               s0c2 (ji,jj) = MAX( rzero, s0c2 (ji,jj)/area(ji,jj) ) 
     264               s0st (ji,jj) = MAX( rzero, s0st (ji,jj)/area(ji,jj) ) 
    243265 
    244266               ! Recover in situ values. 
    245                zindb         = MAX( rzero, SIGN( rone, zs0a(ji,jj) - epsi06 ) ) 
     267               zindb         = MAX( rzero, SIGN( rone, s0a(ji,jj) - epsi06 ) ) 
    246268               zacrith       = 1.0 - ( zindhe * acrit(1) + ( 1.0 - zindhe ) * acrit(2) ) 
    247                zs0a (ji,jj)  = zindb * MIN( zs0a(ji,jj), zacrith ) 
    248                hsnif(ji,jj)  = zindb * ( zs0sn(ji,jj) /MAX( zs0a(ji,jj), epsi16 ) ) 
    249                hicif(ji,jj)  = zindb * ( zs0ice(ji,jj)/MAX( zs0a(ji,jj), epsi16 ) ) 
     269               s0a (ji,jj)  = zindb * MIN( s0a(ji,jj), zacrith ) 
     270               hsnif(ji,jj)  = zindb * ( s0sn(ji,jj) /MAX( s0a(ji,jj), epsi16 ) ) 
     271               hicif(ji,jj)  = zindb * ( s0ice(ji,jj)/MAX( s0a(ji,jj), epsi16 ) ) 
    250272               zindsn        = MAX( rzero, SIGN( rone, hsnif(ji,jj) - epsi06 ) ) 
    251273               zindic        = MAX( rzero, SIGN( rone, hicif(ji,jj) - epsi03 ) ) 
    252274               zindb         = MAX( zindsn, zindic ) 
    253                zs0a (ji,jj)  = zindb * zs0a(ji,jj) 
    254                frld (ji,jj)  = 1.0 - zs0a(ji,jj) 
     275               s0a (ji,jj)  = zindb * s0a(ji,jj) 
     276               frld (ji,jj)  = 1.0 - s0a(ji,jj) 
    255277               hsnif(ji,jj)  = zindsn * hsnif(ji,jj) 
    256278               hicif(ji,jj)  = zindic * hicif(ji,jj) 
    257                zusvosn       = 1.0/MAX( hsnif(ji,jj) * zs0a(ji,jj), epsi16 ) 
    258                zusvoic       = 1.0/MAX( hicif(ji,jj) * zs0a(ji,jj), epsi16 ) 
     279               zusvosn       = 1.0/MAX( hsnif(ji,jj) * s0a(ji,jj), epsi16 ) 
     280               zusvoic       = 1.0/MAX( hicif(ji,jj) * s0a(ji,jj), epsi16 ) 
    259281               zignm         = MAX( rzero,  SIGN( rone, hsndif - hsnif(ji,jj) ) ) 
    260282               zrtt          = 173.15 * rone  
    261283               ztsn          =          zignm   * tbif(ji,jj,1)  & 
    262                               + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * zs0c0(ji,jj)) , tfu(ji,jj) )  
    263                ztic1          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c1(ji,jj) ) , tfu(ji,jj) ) 
    264                ztic2          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c2(ji,jj) ) , tfu(ji,jj) ) 
     284                              + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * s0c0(ji,jj)) , tfu(ji,jj) )  
     285               ztic1          = MIN( MAX( zrtt, rt0_ice * zusvoic * s0c1(ji,jj) ) , tfu(ji,jj) ) 
     286               ztic2          = MIN( MAX( zrtt, rt0_ice * zusvoic * s0c2(ji,jj) ) , tfu(ji,jj) ) 
    265287  
    266288               tbif(ji,jj,1) = zindsn * ztsn  + ( 1.0 - zindsn ) * tfu(ji,jj)                
    267289               tbif(ji,jj,2) = zindic * ztic1 + ( 1.0 - zindic ) * tfu(ji,jj) 
    268290               tbif(ji,jj,3) = zindic * ztic2 + ( 1.0 - zindic ) * tfu(ji,jj) 
    269                qstoif(ji,jj) = zindb  * xlic * zs0st(ji,jj) /  MAX( zs0a(ji,jj), epsi16 ) 
     291               qstoif(ji,jj) = zindb  * xlic * s0st(ji,jj) /  MAX( s0a(ji,jj), epsi16 ) 
    270292            END DO 
    271293         END DO 
    … …  
    273295      ENDIF 
    274296      ! 
    275       IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10) )   CALL ctl_stop('lim_trp_2 : failed to release workspace arrays') 
     297# if defined key_agrif 
     298!RB : less precise but could be enough  
     299!     and avoid above calls to Agrif_sadv_lim2 
     300              CALL Agrif_adv_lim2(kt) 
     301# endif 
     302      ! 
     303      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9) )   & 
     304         &   CALL ctl_stop('lim_trp_2 : failed to release workspace arrays') 
    276305      ! 
    277306   END SUBROUTINE lim_trp_2 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r2717 r2804  
    3434   USE dom_ice_2        ! LIM2: ice domain 
    3535#endif 
     36#if defined key_agrif && defined key_lim2 
     37   USE agrif_lim2_interp 
     38#endif 
    3639 
    3740   IMPLICIT NONE 
    … …  
    9295         &      zdd(jpi,jpj) , zdt   (jpi,jpj) , zds   (jpi,jpj) ,                     & 
    9396         &      zs1(jpi,jpj) , zs2   (jpi,jpj) , zs12  (jpi,jpj) , zresr(jpi,jpj), STAT=ierr(2) ) 
    94          ! 
     97        ! 
    9598      lim_rhg_alloc = MAXVAL(ierr) 
    9699      ! 
    … …  
    506509 
    507510            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    508  
     511#if defined key_agrif 
     512           CALL agrif_dyn_lim(jter ,nevp , 'U') 
     513#endif 
    509514!CDIR NOVERRCHK 
    510515            DO jj = k_j1+1, k_jpj-1 
    … …  
    531536 
    532537            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    533  
     538#if defined key_agrif 
     539           CALL agrif_dyn_lim(jter ,nevp , 'U') 
     540#endif 
    534541         ELSE  
    535542!CDIR NOVERRCHK 
    … …  
    557564 
    558565            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    559  
     566#if defined key_agrif 
     567            CALL agrif_dyn_lim(jter ,nevp , 'V') 
     568#endif 
    560569!CDIR NOVERRCHK 
    561570            DO jj = k_j1+1, k_jpj-1 
    … …  
    585594 
    586595            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    587  
     596#if defined key_agrif 
     597            CALL agrif_dyn_lim(jter ,nevp , 'U') 
     598#endif 
    588599         ENDIF 
    589600 
    … …  
    625636      CALL lbc_lnk( u_ice(:,:), 'U', -1. )  
    626637      CALL lbc_lnk( v_ice(:,:), 'V', -1. )  
     638#if defined key_agrif_lim2 
     639      CALL agrif_dyn_lim(nevp ,nevp , 'U') 
     640      CALL agrif_dyn_lim(nevp ,nevp , 'V') 
     641#endif 
    627642 
    628643      DO jj = k_j1+1, k_jpj-1  

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r2715 r2804  
    2929   REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics 
    3030 
     31   INTEGER, PUBLIC :: nbcline = 0 
    3132   LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator 
    3233   LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator 
    … …  
    3536   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ??? 
    3637    
    37    INTEGER :: tn_id, sn_id, tb_id, sb_id, ta_id, sa_id 
    38    INTEGER :: un_id, vn_id, ua_id, va_id 
    39    INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 
    40    INTEGER :: trn_id, trb_id, tra_id 
     38   INTEGER, PUBLIC :: tn_id, sn_id, tb_id, sb_id, ta_id, sa_id 
     39   INTEGER, PUBLIC :: un_id, vn_id, ua_id, va_id 
     40   INTEGER, PUBLIC :: e1u_id, e2v_id, sshn_id, gcb_id 
     41   INTEGER, PUBLIC :: trn_id, trb_id, tra_id 
    4142 
    4243   !!---------------------------------------------------------------------- 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r2802 r2804  
    1616   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn 
    1717 
    18    INTEGER, PUBLIC :: nbcline = 0 
    19  
    2018   !!---------------------------------------------------------------------- 
    2119   !! NEMO/NST 3.3 , NEMO Consortium (2010) 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r2727 r2804  
    8484# if ! defined key_offline 
    8585      CALL Agrif_InitValues_cont 
    86 # endif        
     86#  if defined key_lim2 
     87!      CALL Agrif_InitValues_cont_lim2 
     88#  endif        
     89# endif 
    8790# if defined key_top 
    8891      CALL Agrif_InitValues_cont_top 
    … …  
    279282 
    280283   END SUBROUTINE agrif_declare_var 
     284 
     285 
     286#  if defined key_lim2 
     287   SUBROUTINE Agrif_InitValues_cont_lim2 
     288      !!---------------------------------------------------------------------- 
     289      !!                 *** ROUTINE Agrif_InitValues_cont_lim2 *** 
     290      !! 
     291      !! ** Purpose :: Initialisation of variables to be interpolated for LIM2 
     292      !!---------------------------------------------------------------------- 
     293      USE Agrif_Util 
     294      USE ice_2 
     295      USE in_out_manager 
     296      USE agrif_lim2_update 
     297      USE agrif_lim2_interp 
     298      USE lib_mpp  
     299      ! 
     300      IMPLICIT NONE 
     301      ! 
     302      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel 
     303      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv, zsadv 
     304      !!---------------------------------------------------------------------- 
     305 
     306      ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7), zsadv(jpi,jpj,42) ) 
     307       
     308      ! 1. Declaration of the type of variable which have to be interpolated 
     309      !--------------------------------------------------------------------- 
     310      CALL agrif_declare_var_lim2 
     311 
     312      ! 2. First interpolations of potentially non zero fields 
     313      !------------------------------------------------------- 
     314      Agrif_SpecialValue=-9999. 
     315      Agrif_UseSpecialValue = .TRUE. 
     316      Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )     
     317      Call Agrif_Bc_variable(zsadv,sadv_ice_id,calledweight=1.,procname=interp_sadv_ice)     
     318      Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   ) 
     319      Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   ) 
     320      Agrif_SpecialValue=0. 
     321      Agrif_UseSpecialValue = .FALSE. 
     322 
     323      ! 3. Some controls 
     324      !----------------- 
     325        
     326#   if ! defined key_lim2_vp 
     327      childfreq = 1. 
     328      CALL agrif_dyn_lim(0 ,1 , 'V') 
     329      CALL agrif_dyn_lim(0 ,1 , 'U') 
     330      childfreq = 0. 
     331#   endif 
     332!RB mandatory but why ??? 
     333      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN 
     334         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc') 
     335         nbclineupdate = nn_fsbc 
     336       ENDIF 
     337      CALL Agrif_Update_lim2(0) 
     338      ! 
     339      DEALLOCATE( zvel, zadv, zsadv ) 
     340      ! 
     341   END SUBROUTINE Agrif_InitValues_cont_lim2 
     342 
     343 
     344   SUBROUTINE agrif_declare_var_lim2 
     345      !!---------------------------------------------------------------------- 
     346      !!                 *** ROUTINE agrif_declare_var_lim2 *** 
     347      !! 
     348      !! ** Purpose :: Declaration of variables to be interpolated for LIM2 
     349      !!---------------------------------------------------------------------- 
     350      USE agrif_util 
     351      USE ice_2 
     352 
     353      IMPLICIT NONE 
     354      !!---------------------------------------------------------------------- 
     355    
     356      ! 1. Declaration of the type of variable which have to be interpolated 
     357      !--------------------------------------------------------------------- 
     358      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )          
     359      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,42/),sadv_ice_id)          
     360#   if defined key_lim2_vp 
     361      CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
     362      CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
     363#   else 
     364      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
     365      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
     366#   endif 
     367           
     368      ! 2. Type of interpolation 
     369      !------------------------- 
     370      CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)    
     371      CALL Agrif_Set_bcinterp(sadv_ice_id,interp=AGRIF_linear)    
     372      Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     373      Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     374 
     375      ! 3. Location of interpolation 
     376      !----------------------------- 
     377      Call Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
     378      Call Agrif_Set_bc(sadv_ice_id,(/0,1/)) 
     379      Call Agrif_Set_bc(u_ice_id,(/0,1/)) 
     380      Call Agrif_Set_bc(v_ice_id,(/0,1/)) 
     381 
     382      ! 5. Update type 
     383      !---------------  
     384      Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
     385      Call Agrif_Set_Updatetype(sadv_ice_id, update = AGRIF_Update_Average) 
     386      Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     387      Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     388 
     389   END SUBROUTINE agrif_declare_var_lim2 
     390#  endif 
    281391# endif 
    282392    
    … …  
    459569      !!---------------------------------------------------------------------- 
    460570      USE agrif_oce  
     571      USE agrif_ice  
    461572      USE in_out_manager 
    462573      USE lib_mpp 
    … …  
    486597      visc_dyn      = rn_sponge_dyn 
    487598      ! 
    488       IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     599      IF( agrif_oce_alloc()  > 0 )   CALL ctl_stop('agrif agrif_oce_alloc: allocation of arrays failed') 
     600# if defined key_lim2 
     601      IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') 
     602# endif 
    489603      ! 
    490604    END SUBROUTINE agrif_nemo_init 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r2715 r2804  
    4848   USE prtctl           ! Print control 
    4949 
     50#if defined key_agrif 
     51   USE agrif_ice 
     52   USE agrif_lim2_update 
     53#endif 
     54 
    5055   IMPLICIT NONE 
    5156   PRIVATE 
    … …  
    110115         ! 
    111116         CALL ice_init_2 
     117#if defined key_agrif 
     118         IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim2  ! AGRIF: set the meshes 
     119# endif 
    112120      ENDIF 
    113121 
    … …  
    115123      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  ! 
    116124         !                                     !----------------------! 
     125#if defined key_agrif 
     126         IF( .NOT. Agrif_Root() ) childfreq = MOD(childfreq,Agrif_rhot()) + 1 
     127#endif 
     128         !   
    117129         !  Bulk Formulea ! 
    118130         !----------------! 
    … …  
    197209         IF( .NOT. lk_c1d ) THEN                       ! Ice dynamics & transport (except in 1D case) 
    198210                           CALL lim_dyn_2      ( kt )      ! Ice dynamics    ( rheology/dynamics ) 
     211 
    199212                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion ) 
    200213           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping  
    … …  
    223236      !                                        !  at all ocean time step  ! 
    224237      !                                        !--------------------------! 
     238#if defined key_agrif && defined key_lim2 
     239      IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt ) 
     240#endif 
    225241      !                                                
    226242      !                                              ! Update surface ocean stresses (only in ice-dynamic case) 

  • branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2715 r2804  
    115115#if defined key_agrif 
    116116      CALL Agrif_Declare_Var       ! AGRIF: set the meshes 
     117# if defined key_lim2 
     118      CALL Agrif_Declare_Var_lim2  ! AGRIF: set the meshes 
     119# endif 
    117120# if defined key_top 
    118121      CALL Agrif_Declare_Var_Top   ! AGRIF: set the meshes 
Note: See TracChangeset for help on using the changeset viewer.