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 3653 for branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 – NEMO

Ignore:
Timestamp:
2012-11-26T11:58:31+01:00 (11 years ago)
Author:
cetlod
Message:

commit the changes from LOCEAN & UKMO merge, see ticket #1021

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r3294 r3653  
    11#if defined key_agrif 
    2    !!---------------------------------------------------------------------- 
    3    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    4    !! $Id$ 
    5    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6    !!---------------------------------------------------------------------- 
    7    SUBROUTINE agrif_before_regridding 
    8    END SUBROUTINE 
    9  
    10    SUBROUTINE Agrif_InitWorkspace 
    11       !!---------------------------------------------------------------------- 
    12       !!                 *** ROUTINE Agrif_InitWorkspace *** 
    13       !!---------------------------------------------------------------------- 
    14       USE par_oce 
    15       USE dom_oce 
    16       USE Agrif_Util 
    17       USE nemogcm 
    18       ! 
    19       IMPLICIT NONE 
    20       !!---------------------------------------------------------------------- 
    21       ! 
    22       IF( .NOT. Agrif_Root() ) THEN 
    23          jpni = Agrif_Parent(jpni) 
    24          jpnj = Agrif_Parent(jpnj) 
    25          jpnij = Agrif_Parent(jpnij) 
    26          jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    27          jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    28          jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    29          jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    30          jpk     = jpkdta 
    31          jpim1   = jpi-1 
    32          jpjm1   = jpj-1 
    33          jpkm1   = jpk-1                                         
    34          jpij    = jpi*jpj 
    35          jpidta  = jpiglo 
    36          jpjdta  = jpjglo 
    37          jpizoom = 1 
    38          jpjzoom = 1 
    39          nperio  = 0 
    40          jperio  = 0 
    41       ENDIF 
    42       ! 
    43    END SUBROUTINE Agrif_InitWorkspace 
    44  
    45  
    46    SUBROUTINE Agrif_InitValues 
    47       !!---------------------------------------------------------------------- 
    48       !!                 *** ROUTINE Agrif_InitValues *** 
    49       !! 
    50       !! ** Purpose :: Declaration of variables to be interpolated 
    51       !!---------------------------------------------------------------------- 
    52       USE Agrif_Util 
    53       USE oce  
    54       USE dom_oce 
    55       USE nemogcm 
    56       USE tradmp 
    57       USE obc_par 
    58       USE bdy_par 
    59  
    60       IMPLICIT NONE 
    61       !!---------------------------------------------------------------------- 
    62  
    63       ! 0. Initializations 
    64       !------------------- 
     2!!---------------------------------------------------------------------- 
     3!! NEMO/NST 3.4 , NEMO Consortium (2012) 
     4!! $Id$ 
     5!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     6!!---------------------------------------------------------------------- 
     7SUBROUTINE agrif_user 
     8END SUBROUTINE agrif_user 
     9 
     10SUBROUTINE agrif_before_regridding 
     11END SUBROUTINE agrif_before_regridding 
     12 
     13SUBROUTINE Agrif_InitWorkspace 
     14   !!---------------------------------------------------------------------- 
     15   !!                 *** ROUTINE Agrif_InitWorkspace *** 
     16   !!---------------------------------------------------------------------- 
     17   USE par_oce 
     18   USE dom_oce 
     19   USE Agrif_Util 
     20   USE nemogcm 
     21   ! 
     22   IMPLICIT NONE 
     23   !!---------------------------------------------------------------------- 
     24   ! 
     25   IF( .NOT. Agrif_Root() ) THEN 
     26      jpni = Agrif_Parent(jpni) 
     27      jpnj = Agrif_Parent(jpnj) 
     28      jpnij = Agrif_Parent(jpnij) 
     29      jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     30      jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     31      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     32      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     33      jpk     = jpkdta 
     34      jpim1   = jpi-1 
     35      jpjm1   = jpj-1 
     36      jpkm1   = jpk-1                                         
     37      jpij    = jpi*jpj 
     38      jpidta  = jpiglo 
     39      jpjdta  = jpjglo 
     40      jpizoom = 1 
     41      jpjzoom = 1 
     42      nperio  = 0 
     43      jperio  = 0 
     44   ENDIF 
     45   ! 
     46END SUBROUTINE Agrif_InitWorkspace 
     47 
     48 
     49SUBROUTINE Agrif_InitValues 
     50   !!---------------------------------------------------------------------- 
     51   !!                 *** ROUTINE Agrif_InitValues *** 
     52   !! 
     53   !! ** Purpose :: Declaration of variables to be interpolated 
     54   !!---------------------------------------------------------------------- 
     55   USE Agrif_Util 
     56   USE oce  
     57   USE dom_oce 
     58   USE nemogcm 
     59   USE tradmp 
     60   USE obc_par 
     61   USE bdy_par 
     62 
     63   IMPLICIT NONE 
     64   !!---------------------------------------------------------------------- 
     65 
     66   ! 0. Initializations 
     67   !------------------- 
    6568#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 
    66       jp_cfg = -1    ! set special value for jp_cfg on fine grids 
    67       cp_cfg = "default" 
     69   jp_cfg = -1    ! set special value for jp_cfg on fine grids 
     70   cp_cfg = "default" 
    6871#endif 
    6972 
    70       ! Specific fine grid Initializations 
    71       ! no tracer damping on fine grids 
    72       ln_tradmp = .FALSE. 
    73       ! no open boundary on fine grids 
    74       lk_obc = .FALSE. 
    75       lk_bdy = .FALSE. 
    76  
    77       CALL nemo_init  ! Initializations of each fine grid 
    78       CALL agrif_nemo_init 
     73   ! Specific fine grid Initializations 
     74   ! no tracer damping on fine grids 
     75   ln_tradmp = .FALSE. 
     76   ! no open boundary on fine grids 
     77   lk_obc = .FALSE. 
     78   lk_bdy = .FALSE. 
     79 
     80   CALL nemo_init  ! Initializations of each fine grid 
     81   CALL agrif_nemo_init 
     82   CALL Agrif_InitValues_cont_dom 
    7983# if ! defined key_offline 
    80       CALL Agrif_InitValues_cont 
     84   CALL Agrif_InitValues_cont 
    8185# endif        
    8286# if defined key_top 
    83       CALL Agrif_InitValues_cont_top 
     87   CALL Agrif_InitValues_cont_top 
    8488# endif       
    85    END SUBROUTINE Agrif_initvalues 
     89END SUBROUTINE Agrif_initvalues 
     90 
     91 
     92SUBROUTINE Agrif_InitValues_cont_dom 
     93   !!---------------------------------------------------------------------- 
     94   !!                 *** ROUTINE Agrif_InitValues_cont *** 
     95   !! 
     96   !! ** Purpose ::   Declaration of variables to be interpolated 
     97   !!---------------------------------------------------------------------- 
     98   USE Agrif_Util 
     99   USE oce  
     100   USE dom_oce 
     101   USE nemogcm 
     102   USE sol_oce 
     103   USE in_out_manager 
     104   USE agrif_opa_update 
     105   USE agrif_opa_interp 
     106   USE agrif_opa_sponge 
     107   ! 
     108   IMPLICIT NONE 
     109   ! 
     110   !!---------------------------------------------------------------------- 
     111 
     112   ! Declaration of the type of variable which have to be interpolated 
     113   !--------------------------------------------------------------------- 
     114   CALL agrif_declare_var_dom 
     115   ! 
     116END SUBROUTINE Agrif_InitValues_cont_dom 
     117 
     118 
     119SUBROUTINE agrif_declare_var_dom 
     120   !!---------------------------------------------------------------------- 
     121   !!                 *** ROUTINE agrif_declarE_var *** 
     122   !! 
     123   !! ** Purpose :: Declaration of variables to be interpolated 
     124   !!---------------------------------------------------------------------- 
     125   USE agrif_util 
     126   USE par_oce       !   ONLY : jpts 
     127   USE oce 
     128   IMPLICIT NONE 
     129   !!---------------------------------------------------------------------- 
     130 
     131   ! 1. Declaration of the type of variable which have to be interpolated 
     132   !--------------------------------------------------------------------- 
     133   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     134   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
     135 
     136 
     137   ! 2. Type of interpolation 
     138   !------------------------- 
     139   Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     140   Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     141 
     142   ! 3. Location of interpolation 
     143   !----------------------------- 
     144   Call Agrif_Set_bc(e1u_id,(/0,0/)) 
     145   Call Agrif_Set_bc(e2v_id,(/0,0/)) 
     146 
     147   ! 5. Update type 
     148   !---------------  
     149   Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     150   Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     151 
     152END SUBROUTINE agrif_declare_var_dom 
     153 
    86154 
    87155# if ! defined key_offline 
    88156 
    89    SUBROUTINE Agrif_InitValues_cont 
    90       !!---------------------------------------------------------------------- 
    91       !!                 *** ROUTINE Agrif_InitValues_cont *** 
    92       !! 
    93       !! ** Purpose ::   Declaration of variables to be interpolated 
    94       !!---------------------------------------------------------------------- 
    95       USE Agrif_Util 
    96       USE oce  
    97       USE dom_oce 
    98       USE nemogcm 
    99       USE sol_oce 
    100       USE in_out_manager 
    101       USE agrif_opa_update 
    102       USE agrif_opa_interp 
    103       USE agrif_opa_sponge 
    104       ! 
    105       IMPLICIT NONE 
    106       ! 
    107       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
    108       REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
    109       LOGICAL :: check_namelist 
    110       !!---------------------------------------------------------------------- 
    111  
    112       ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
    113       ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
    114  
    115  
    116       ! 1. Declaration of the type of variable which have to be interpolated 
    117       !--------------------------------------------------------------------- 
    118       CALL agrif_declare_var 
    119  
    120       ! 2. First interpolations of potentially non zero fields 
    121       !------------------------------------------------------- 
    122       Agrif_SpecialValue=0. 
    123       Agrif_UseSpecialValue = .TRUE. 
    124       Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
    125       Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
    126  
    127       Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
    128       Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
    129       Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
    130       Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
    131       Agrif_UseSpecialValue = .FALSE. 
    132  
    133       ! 3. Some controls 
    134       !----------------- 
    135       check_namelist = .true. 
    136              
    137       IF( check_namelist ) THEN 
    138       
    139          ! Check time steps            
    140          IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
    141             WRITE(*,*) 'incompatible time step between grids' 
    142             WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    143             WRITE(*,*) 'child  grid value : ',nint(rdt) 
    144             WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     157SUBROUTINE Agrif_InitValues_cont 
     158   !!---------------------------------------------------------------------- 
     159   !!                 *** ROUTINE Agrif_InitValues_cont *** 
     160   !! 
     161   !! ** Purpose ::   Declaration of variables to be interpolated 
     162   !!---------------------------------------------------------------------- 
     163   USE Agrif_Util 
     164   USE oce  
     165   USE dom_oce 
     166   USE nemogcm 
     167   USE sol_oce 
     168   USE in_out_manager 
     169   USE agrif_opa_update 
     170   USE agrif_opa_interp 
     171   USE agrif_opa_sponge 
     172   ! 
     173   IMPLICIT NONE 
     174   ! 
     175   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
     176   REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
     177   LOGICAL :: check_namelist 
     178   !!---------------------------------------------------------------------- 
     179 
     180   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
     181   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
     182 
     183 
     184   ! 1. Declaration of the type of variable which have to be interpolated 
     185   !--------------------------------------------------------------------- 
     186   CALL agrif_declare_var 
     187 
     188   ! 2. First interpolations of potentially non zero fields 
     189   !------------------------------------------------------- 
     190   Agrif_SpecialValue=0. 
     191   Agrif_UseSpecialValue = .TRUE. 
     192   Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
     193   Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
     194 
     195   Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
     196   Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
     197   Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
     198   Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
     199   Agrif_UseSpecialValue = .FALSE. 
     200 
     201   ! 3. Some controls 
     202   !----------------- 
     203   check_namelist = .true. 
     204 
     205   IF( check_namelist ) THEN 
     206 
     207      ! Check time steps            
     208      IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
     209         WRITE(*,*) 'incompatible time step between grids' 
     210         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
     211         WRITE(*,*) 'child  grid value : ',nint(rdt) 
     212         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     213         STOP 
     214      ENDIF 
     215 
     216      ! Check run length 
     217      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     218           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     219         WRITE(*,*) 'incompatible run length between grids' 
     220         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
     221              Agrif_Parent(nit000)+1),' time step' 
     222         WRITE(*,*) 'child  grid value : ', & 
     223              (nitend-nit000+1),' time step' 
     224         WRITE(*,*) 'value on child grid should be : ', & 
     225              Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     226              Agrif_Parent(nit000)+1) 
     227         STOP 
     228      ENDIF 
     229 
     230      ! Check coordinates 
     231      IF( ln_zps ) THEN 
     232         ! check parameters for partial steps  
     233         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     234            WRITE(*,*) 'incompatible e3zps_min between grids' 
     235            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     236            WRITE(*,*) 'child grid  :',e3zps_min 
     237            WRITE(*,*) 'those values should be identical' 
    145238            STOP 
    146239         ENDIF 
    147           
    148          ! Check run length 
    149          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    150             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    151             WRITE(*,*) 'incompatible run length between grids' 
    152             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    153                Agrif_Parent(nit000)+1),' time step' 
    154             WRITE(*,*) 'child  grid value : ', & 
    155                (nitend-nit000+1),' time step' 
    156             WRITE(*,*) 'value on child grid should be : ', & 
    157                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    158                Agrif_Parent(nit000)+1) 
     240         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
     241            WRITE(*,*) 'incompatible e3zps_rat between grids' 
     242            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     243            WRITE(*,*) 'child grid  :',e3zps_rat 
     244            WRITE(*,*) 'those values should be identical'                   
    159245            STOP 
    160246         ENDIF 
    161           
    162          ! Check coordinates 
    163          IF( ln_zps ) THEN 
    164             ! check parameters for partial steps  
    165             IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
    166                WRITE(*,*) 'incompatible e3zps_min between grids' 
    167                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    168                WRITE(*,*) 'child grid  :',e3zps_min 
    169                WRITE(*,*) 'those values should be identical' 
    170                STOP 
    171             ENDIF           
    172             IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
    173                WRITE(*,*) 'incompatible e3zps_rat between grids' 
    174                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    175                WRITE(*,*) 'child grid  :',e3zps_rat 
    176                WRITE(*,*) 'those values should be identical'                   
    177                STOP 
    178             ENDIF 
     247      ENDIF 
     248   ENDIF 
     249 
     250   CALL Agrif_Update_tra(0) 
     251   CALL Agrif_Update_dyn(0) 
     252 
     253   nbcline = 0 
     254   ! 
     255   DEALLOCATE(tabtstemp) 
     256   DEALLOCATE(tabuvtemp) 
     257   ! 
     258END SUBROUTINE Agrif_InitValues_cont 
     259 
     260 
     261SUBROUTINE agrif_declare_var 
     262   !!---------------------------------------------------------------------- 
     263   !!                 *** ROUTINE agrif_declarE_var *** 
     264   !! 
     265   !! ** Purpose :: Declaration of variables to be interpolated 
     266   !!---------------------------------------------------------------------- 
     267   USE agrif_util 
     268   USE par_oce       !   ONLY : jpts 
     269   USE oce 
     270   IMPLICIT NONE 
     271   !!---------------------------------------------------------------------- 
     272 
     273   ! 1. Declaration of the type of variable which have to be interpolated 
     274   !--------------------------------------------------------------------- 
     275   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     276   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
     277   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
     278 
     279   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
     280   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
     281   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
     282   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
     283 
     284   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
     285   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
     286 
     287   ! 2. Type of interpolation 
     288   !------------------------- 
     289   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
     290   CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
     291 
     292   Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     293   Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     294 
     295   Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     296   Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     297 
     298   ! 3. Location of interpolation 
     299   !----------------------------- 
     300   Call Agrif_Set_bc(un_id,(/0,1/)) 
     301   Call Agrif_Set_bc(vn_id,(/0,1/)) 
     302 
     303   Call Agrif_Set_bc(tsn_id,(/0,1/)) 
     304   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
     305 
     306   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
     307   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
     308 
     309   ! 5. Update type 
     310   !---------------  
     311   Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     312   Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
     313 
     314   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     315   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
     316 
     317   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     318   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     319 
     320END SUBROUTINE agrif_declare_var 
     321# endif 
     322 
     323#  if defined key_lim2 
     324SUBROUTINE Agrif_InitValues_cont_lim2 
     325   !!---------------------------------------------------------------------- 
     326   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 *** 
     327   !! 
     328   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2 
     329   !!---------------------------------------------------------------------- 
     330   USE Agrif_Util 
     331   USE ice_2 
     332   USE agrif_ice 
     333   USE in_out_manager 
     334   USE agrif_lim2_update 
     335   USE agrif_lim2_interp 
     336   USE lib_mpp 
     337   ! 
     338   IMPLICIT NONE 
     339   ! 
     340   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel 
     341   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv 
     342   !!---------------------------------------------------------------------- 
     343 
     344   ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7)) 
     345 
     346   ! 1. Declaration of the type of variable which have to be interpolated 
     347   !--------------------------------------------------------------------- 
     348   CALL agrif_declare_var_lim2 
     349 
     350   ! 2. First interpolations of potentially non zero fields 
     351   !------------------------------------------------------- 
     352   Agrif_SpecialValue=-9999. 
     353   Agrif_UseSpecialValue = .TRUE. 
     354   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice ) 
     355   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   ) 
     356   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   ) 
     357   Agrif_SpecialValue=0. 
     358   Agrif_UseSpecialValue = .FALSE. 
     359 
     360   ! 3. Some controls 
     361   !----------------- 
     362 
     363#   if ! defined key_lim2_vp 
     364   lim_nbstep = 1. 
     365   CALL agrif_rhg_lim2_load 
     366   CALL agrif_trp_lim2_load 
     367   lim_nbstep = 0. 
     368#   endif 
     369   !RB mandatory but why ??? 
     370   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN 
     371   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc') 
     372   !         nbclineupdate = nn_fsbc 
     373   !       ENDIF 
     374   CALL Agrif_Update_lim2(0) 
     375   ! 
     376   DEALLOCATE( zvel, zadv ) 
     377   ! 
     378END SUBROUTINE Agrif_InitValues_cont_lim2 
     379 
     380SUBROUTINE agrif_declare_var_lim2 
     381   !!---------------------------------------------------------------------- 
     382   !!                 *** ROUTINE agrif_declare_var_lim2 *** 
     383   !! 
     384   !! ** Purpose :: Declaration of variables to be interpolated for LIM2 
     385   !!---------------------------------------------------------------------- 
     386   USE agrif_util 
     387   USE ice_2 
     388 
     389   IMPLICIT NONE 
     390   !!---------------------------------------------------------------------- 
     391 
     392   ! 1. Declaration of the type of variable which have to be interpolated 
     393   !--------------------------------------------------------------------- 
     394   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id ) 
     395#   if defined key_lim2_vp 
     396   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
     397   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
     398#   else 
     399   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
     400   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
     401#   endif 
     402 
     403   ! 2. Type of interpolation 
     404   !------------------------- 
     405   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear) 
     406   Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     407   Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     408 
     409   ! 3. Location of interpolation 
     410   !----------------------------- 
     411   Call Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
     412   Call Agrif_Set_bc(u_ice_id,(/0,1/)) 
     413   Call Agrif_Set_bc(v_ice_id,(/0,1/)) 
     414 
     415   ! 5. Update type 
     416   !--------------- 
     417   Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
     418   Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     419   Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     420 
     421END SUBROUTINE agrif_declare_var_lim2 
     422#  endif 
     423 
     424 
     425# if defined key_top 
     426SUBROUTINE Agrif_InitValues_cont_top 
     427   !!---------------------------------------------------------------------- 
     428   !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
     429   !! 
     430   !! ** Purpose :: Declaration of variables to be interpolated 
     431   !!---------------------------------------------------------------------- 
     432   USE Agrif_Util 
     433   USE oce  
     434   USE dom_oce 
     435   USE nemogcm 
     436   USE par_trc 
     437   USE trc 
     438   USE in_out_manager 
     439   USE agrif_top_update 
     440   USE agrif_top_interp 
     441   USE agrif_top_sponge 
     442   ! 
     443   IMPLICIT NONE 
     444   ! 
     445   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
     446   LOGICAL :: check_namelist 
     447   !!---------------------------------------------------------------------- 
     448 
     449   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
     450 
     451 
     452   ! 1. Declaration of the type of variable which have to be interpolated 
     453   !--------------------------------------------------------------------- 
     454   CALL agrif_declare_var_top 
     455 
     456   ! 2. First interpolations of potentially non zero fields 
     457   !------------------------------------------------------- 
     458   Agrif_SpecialValue=0. 
     459   Agrif_UseSpecialValue = .TRUE. 
     460   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn) 
     461   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
     462   Agrif_UseSpecialValue = .FALSE. 
     463 
     464   ! 3. Some controls 
     465   !----------------- 
     466   check_namelist = .true. 
     467 
     468   IF( check_namelist ) THEN 
     469#  if defined offline      
     470      ! Check time steps 
     471      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
     472         WRITE(*,*) 'incompatible time step between grids' 
     473         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
     474         WRITE(*,*) 'child  grid value : ',nint(rdt) 
     475         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     476         STOP 
     477      ENDIF 
     478 
     479      ! Check run length 
     480      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     481           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     482         WRITE(*,*) 'incompatible run length between grids' 
     483         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
     484              Agrif_Parent(nit000)+1),' time step' 
     485         WRITE(*,*) 'child  grid value : ', & 
     486              (nitend-nit000+1),' time step' 
     487         WRITE(*,*) 'value on child grid should be : ', & 
     488              Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     489              Agrif_Parent(nit000)+1) 
     490         STOP 
     491      ENDIF 
     492 
     493      ! Check coordinates 
     494      IF( ln_zps ) THEN 
     495         ! check parameters for partial steps  
     496         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     497            WRITE(*,*) 'incompatible e3zps_min between grids' 
     498            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     499            WRITE(*,*) 'child grid  :',e3zps_min 
     500            WRITE(*,*) 'those values should be identical' 
     501            STOP 
     502         ENDIF 
     503         IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
     504            WRITE(*,*) 'incompatible e3zps_rat between grids' 
     505            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     506            WRITE(*,*) 'child grid  :',e3zps_rat 
     507            WRITE(*,*) 'those values should be identical'                   
     508            STOP 
    179509         ENDIF 
    180510      ENDIF 
    181         
    182       CALL Agrif_Update_tra(0) 
    183       CALL Agrif_Update_dyn(0) 
    184  
    185       nbcline = 0 
    186       ! 
    187       DEALLOCATE(tabtstemp) 
    188       DEALLOCATE(tabuvtemp) 
    189       ! 
    190    END SUBROUTINE Agrif_InitValues_cont 
    191  
    192  
    193    SUBROUTINE agrif_declare_var 
    194       !!---------------------------------------------------------------------- 
    195       !!                 *** ROUTINE agrif_declarE_var *** 
    196       !! 
    197       !! ** Purpose :: Declaration of variables to be interpolated 
    198       !!---------------------------------------------------------------------- 
    199       USE agrif_util 
    200       USE par_oce       !   ONLY : jpts 
    201       USE oce 
    202       IMPLICIT NONE 
    203       !!---------------------------------------------------------------------- 
    204     
    205       ! 1. Declaration of the type of variable which have to be interpolated 
    206       !--------------------------------------------------------------------- 
    207       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
    208       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
    209       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
    210  
    211       CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
    212       CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
    213       CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
    214       CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
    215     
    216       CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    217       CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    218  
    219       CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    220       CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
    221         
    222       ! 2. Type of interpolation 
    223       !------------------------- 
    224       CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    225       CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
    226     
    227       Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    228       Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    229  
    230       Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    231       Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    232  
    233       Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    234       Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    235  
    236       ! 3. Location of interpolation 
    237       !----------------------------- 
    238       Call Agrif_Set_bc(un_id,(/0,1/)) 
    239       Call Agrif_Set_bc(vn_id,(/0,1/)) 
    240  
    241       Call Agrif_Set_bc(e1u_id,(/0,0/)) 
    242       Call Agrif_Set_bc(e2v_id,(/0,0/)) 
    243  
    244       Call Agrif_Set_bc(tsn_id,(/0,1/)) 
    245       Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
    246  
    247       Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
    248       Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
    249  
    250       ! 5. Update type 
    251       !---------------  
    252       Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    253       Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
    254  
    255       Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    256       Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
    257  
    258       Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    259       Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    260  
    261       Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    262       Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    263  
    264    END SUBROUTINE agrif_declare_var 
     511#  endif          
     512      ! Check passive tracer cell 
     513      IF( nn_dttrc .ne. 1 ) THEN 
     514         WRITE(*,*) 'nn_dttrc should be equal to 1' 
     515      ENDIF 
     516   ENDIF 
     517 
     518!ch   CALL Agrif_Update_trc(0) 
     519   nbcline_trc = 0 
     520   ! 
     521   DEALLOCATE(tabtrtemp) 
     522   ! 
     523END SUBROUTINE Agrif_InitValues_cont_top 
     524 
     525 
     526SUBROUTINE agrif_declare_var_top 
     527   !!---------------------------------------------------------------------- 
     528   !!                 *** ROUTINE agrif_declare_var_top *** 
     529   !! 
     530   !! ** Purpose :: Declaration of TOP variables to be interpolated 
     531   !!---------------------------------------------------------------------- 
     532   USE agrif_util 
     533   USE dom_oce 
     534   USE trc 
     535 
     536   IMPLICIT NONE 
     537 
     538   ! 1. Declaration of the type of variable which have to be interpolated 
     539   !--------------------------------------------------------------------- 
     540   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     541   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
     542   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
     543 
     544   ! 2. Type of interpolation 
     545   !------------------------- 
     546   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
     547   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 
     548 
     549   ! 3. Location of interpolation 
     550   !----------------------------- 
     551   Call Agrif_Set_bc(trn_id,(/0,1/)) 
     552   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 
     553 
     554   ! 5. Update type 
     555   !---------------  
     556   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
     557   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 
     558 
     559 
     560END SUBROUTINE agrif_declare_var_top 
    265561# endif 
    266     
    267 # if defined key_top 
    268    SUBROUTINE Agrif_InitValues_cont_top 
    269       !!---------------------------------------------------------------------- 
    270       !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
    271       !! 
    272       !! ** Purpose :: Declaration of variables to be interpolated 
    273       !!---------------------------------------------------------------------- 
    274       USE Agrif_Util 
    275       USE oce  
    276       USE dom_oce 
    277       USE nemogcm 
    278       USE trc 
    279       USE in_out_manager 
    280       USE agrif_top_update 
    281       USE agrif_top_interp 
    282       USE agrif_top_sponge 
    283       ! 
    284       IMPLICIT NONE 
    285       ! 
    286       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
    287       LOGICAL :: check_namelist 
    288       !!---------------------------------------------------------------------- 
    289  
    290       ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
    291        
    292        
    293       ! 1. Declaration of the type of variable which have to be interpolated 
    294       !--------------------------------------------------------------------- 
    295       CALL agrif_declare_var_top 
    296  
    297       ! 2. First interpolations of potentially non zero fields 
    298       !------------------------------------------------------- 
    299       Agrif_SpecialValue=0. 
    300       Agrif_UseSpecialValue = .TRUE. 
    301       Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.) 
    302       Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
    303       Agrif_UseSpecialValue = .FALSE. 
    304  
    305       ! 3. Some controls 
    306       !----------------- 
    307       check_namelist = .true. 
    308              
    309       IF( check_namelist ) THEN 
    310 #  if defined offline      
    311          ! Check time steps 
    312          IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
    313             WRITE(*,*) 'incompatible time step between grids' 
    314             WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    315             WRITE(*,*) 'child  grid value : ',nint(rdt) 
    316             WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    317             STOP 
    318          ENDIF 
    319  
    320          ! Check run length 
    321          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    322             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    323             WRITE(*,*) 'incompatible run length between grids' 
    324             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    325                Agrif_Parent(nit000)+1),' time step' 
    326             WRITE(*,*) 'child  grid value : ', & 
    327                (nitend-nit000+1),' time step' 
    328             WRITE(*,*) 'value on child grid should be : ', & 
    329                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    330                Agrif_Parent(nit000)+1) 
    331             STOP 
    332          ENDIF 
    333           
    334          ! Check coordinates 
    335          IF( ln_zps ) THEN 
    336             ! check parameters for partial steps  
    337             IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
    338                WRITE(*,*) 'incompatible e3zps_min between grids' 
    339                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    340                WRITE(*,*) 'child grid  :',e3zps_min 
    341                WRITE(*,*) 'those values should be identical' 
    342                STOP 
    343             ENDIF           
    344             IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
    345                WRITE(*,*) 'incompatible e3zps_rat between grids' 
    346                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    347                WRITE(*,*) 'child grid  :',e3zps_rat 
    348                WRITE(*,*) 'those values should be identical'                   
    349                STOP 
    350             ENDIF 
    351          ENDIF 
    352 #  endif          
    353         ! Check passive tracer cell 
    354         IF( nn_dttrc .ne. 1 ) THEN 
    355            WRITE(*,*) 'nn_dttrc should be equal to 1' 
    356         ENDIF 
    357       ENDIF 
    358         
    359       CALL Agrif_Update_trc(0) 
    360       nbcline_trc = 0 
    361       ! 
    362       DEALLOCATE(tabtrtemp) 
    363       ! 
    364    END SUBROUTINE Agrif_InitValues_cont_top 
    365  
    366  
    367    SUBROUTINE agrif_declare_var_top 
    368       !!---------------------------------------------------------------------- 
    369       !!                 *** ROUTINE agrif_declare_var_top *** 
    370       !! 
    371       !! ** Purpose :: Declaration of TOP variables to be interpolated 
    372       !!---------------------------------------------------------------------- 
    373       USE agrif_util 
    374       USE dom_oce 
    375       USE trc 
    376        
    377       IMPLICIT NONE 
    378     
    379       ! 1. Declaration of the type of variable which have to be interpolated 
    380       !--------------------------------------------------------------------- 
    381       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    382       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
    383       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
    384 #  if defined key_offline 
    385       CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    386       CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    387 #  endif 
    388         
    389       ! 2. Type of interpolation 
    390       !------------------------- 
    391       CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
    392       CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 
    393     
    394 #  if defined key_offline 
    395       Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    396       Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    397 #  endif 
    398  
    399       ! 3. Location of interpolation 
    400       !----------------------------- 
    401 #  if defined key_offline 
    402       Call Agrif_Set_bc(e1u_id,(/0,0/)) 
    403       Call Agrif_Set_bc(e2v_id,(/0,0/)) 
    404 #  endif 
    405       Call Agrif_Set_bc(trn_id,(/0,1/)) 
    406       Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 
    407  
    408       ! 5. Update type 
    409       !---------------  
    410       Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
    411       Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 
    412  
    413 #  if defined key_offline 
    414       Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    415       Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    416 #  endif 
    417  
    418    END SUBROUTINE agrif_declare_var_top 
     562 
     563SUBROUTINE Agrif_detect( kg, ksizex ) 
     564   !!---------------------------------------------------------------------- 
     565   !!   *** ROUTINE Agrif_detect *** 
     566   !!---------------------------------------------------------------------- 
     567   USE Agrif_Types 
     568   ! 
     569   INTEGER, DIMENSION(2) :: ksizex 
     570   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
     571   !!---------------------------------------------------------------------- 
     572   ! 
     573   RETURN 
     574   ! 
     575END SUBROUTINE Agrif_detect 
     576 
     577 
     578SUBROUTINE agrif_nemo_init 
     579   !!---------------------------------------------------------------------- 
     580   !!                     *** ROUTINE agrif_init *** 
     581   !!---------------------------------------------------------------------- 
     582   USE agrif_oce  
     583   USE agrif_ice 
     584   USE in_out_manager 
     585   USE lib_mpp 
     586   IMPLICIT NONE 
     587   ! 
     588   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
     589   !!---------------------------------------------------------------------- 
     590   ! 
     591   REWIND( numnam )                ! Read namagrif namelist 
     592   READ  ( numnam, namagrif ) 
     593   ! 
     594   IF(lwp) THEN                    ! control print 
     595      WRITE(numout,*) 
     596      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 
     597      WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     598      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
     599      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update 
     600      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s' 
     601      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
     602      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
     603      WRITE(numout,*)  
     604   ENDIF 
     605   ! 
     606   ! convert DOCTOR namelist name into OLD names 
     607   nbclineupdate = nn_cln_update 
     608   visc_tra      = rn_sponge_tra 
     609   visc_dyn      = rn_sponge_dyn 
     610   ! 
     611   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     612# if defined key_lim2 
     613   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') 
    419614# endif 
    420     
    421    SUBROUTINE Agrif_detect( kg, ksizex ) 
    422       !!---------------------------------------------------------------------- 
    423       !!   *** ROUTINE Agrif_detect *** 
    424       !!---------------------------------------------------------------------- 
    425       USE Agrif_Types 
    426       ! 
    427       INTEGER, DIMENSION(2) :: ksizex 
    428       INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    429       !!---------------------------------------------------------------------- 
    430       ! 
    431       RETURN 
    432       ! 
    433    END SUBROUTINE Agrif_detect 
    434  
    435  
    436    SUBROUTINE agrif_nemo_init 
    437       !!---------------------------------------------------------------------- 
    438       !!                     *** ROUTINE agrif_init *** 
    439       !!---------------------------------------------------------------------- 
    440       USE agrif_oce  
    441       USE in_out_manager 
    442       USE lib_mpp 
    443       IMPLICIT NONE 
    444       ! 
    445       NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
    446       !!---------------------------------------------------------------------- 
    447       ! 
    448       REWIND( numnam )                ! Read namagrif namelist 
    449       READ  ( numnam, namagrif ) 
    450       ! 
    451       IF(lwp) THEN                    ! control print 
    452          WRITE(numout,*) 
    453          WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 
    454          WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    455          WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    456          WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update 
    457          WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s' 
    458          WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
    459          WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    460          WRITE(numout,*)  
    461       ENDIF 
    462       ! 
    463       ! convert DOCTOR namelist name into OLD names 
    464       nbclineupdate = nn_cln_update 
    465       visc_tra      = rn_sponge_tra 
    466       visc_dyn      = rn_sponge_dyn 
    467       ! 
    468       IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
    469       ! 
    470     END SUBROUTINE agrif_nemo_init 
     615   ! 
     616END SUBROUTINE agrif_nemo_init 
    471617 
    472618# if defined key_mpp_mpi 
    473619 
    474    SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    475       !!---------------------------------------------------------------------- 
    476       !!                     *** ROUTINE Agrif_detect *** 
    477       !!---------------------------------------------------------------------- 
    478       USE dom_oce 
    479       IMPLICIT NONE 
    480       ! 
    481       INTEGER :: indglob, indloc, nprocloc, i 
    482       !!---------------------------------------------------------------------- 
    483       ! 
    484       SELECT CASE( i ) 
    485       CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    486       CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1  
    487       CASE(3)   ;   indglob = indloc 
    488       CASE(4)   ;   indglob = indloc 
    489       END SELECT 
    490       ! 
    491    END SUBROUTINE Agrif_InvLoc 
     620SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
     621   !!---------------------------------------------------------------------- 
     622   !!                     *** ROUTINE Agrif_detect *** 
     623   !!---------------------------------------------------------------------- 
     624   USE dom_oce 
     625   IMPLICIT NONE 
     626   ! 
     627   INTEGER :: indglob, indloc, nprocloc, i 
     628   !!---------------------------------------------------------------------- 
     629   ! 
     630   SELECT CASE( i ) 
     631   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
     632   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1  
     633   CASE(3)   ;   indglob = indloc 
     634   CASE(4)   ;   indglob = indloc 
     635   END SELECT 
     636   ! 
     637END SUBROUTINE Agrif_InvLoc 
    492638 
    493639# endif 
    494640 
    495641#else 
    496    SUBROUTINE Subcalledbyagrif 
    497       !!---------------------------------------------------------------------- 
    498       !!                   *** ROUTINE Subcalledbyagrif *** 
    499       !!---------------------------------------------------------------------- 
    500       WRITE(*,*) 'Impossible to be here' 
    501    END SUBROUTINE Subcalledbyagrif 
     642SUBROUTINE Subcalledbyagrif 
     643   !!---------------------------------------------------------------------- 
     644   !!                   *** ROUTINE Subcalledbyagrif *** 
     645   !!---------------------------------------------------------------------- 
     646   WRITE(*,*) 'Impossible to be here' 
     647END SUBROUTINE Subcalledbyagrif 
    502648#endif 
Note: See TracChangeset for help on using the changeset viewer.