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 2715 for trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r2528 r2715  
    55   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    66   !!---------------------------------------------------------------------- 
     7   SUBROUTINE agrif_before_regridding 
     8   END SUBROUTINE 
    79 
    810   SUBROUTINE Agrif_InitWorkspace 
    … …  
    1315      USE dom_oce 
    1416      USE Agrif_Util 
    15       !! 
    16       IMPLICIT NONE 
    17       !! 
    18 #if defined key_mpp_dyndist 
    19       CHARACTER(len=20) :: namelistname 
    20       INTEGER nummpp 
    21       NAMELIST/nammpp_dyndist/ jpni, jpnj, jpnij 
    22 #endif 
    23       !!---------------------------------------------------------------------- 
    24  
    25 #if defined key_mpp_dyndist 
    26       ! MPP dynamical distribution : read the processor cutting in the namelist 
    27       IF( Agrif_Nbstepint() == 0 ) THEN 
    28         nummpp = Agrif_Get_Unit() 
    29         namelistname='namelist' 
    30         IF(.NOT. Agrif_Root() )   namelistname=TRIM(Agrif_CFixed())//'_namelist' 
    31         ! 
    32         OPEN (nummpp,file=namelistname,status='OLD',form='formatted') 
    33         READ (nummpp,nammpp_dyndist) 
    34         CLOSE(nummpp) 
    35       ENDIF 
    36 #endif 
    37  
     17      USE nemogcm 
     18      ! 
     19      IMPLICIT NONE 
     20      !!---------------------------------------------------------------------- 
     21      ! 
    3822      IF( .NOT. Agrif_Root() ) THEN 
     23         jpni = Agrif_Parent(jpni) 
     24         jpnj = Agrif_Parent(jpnj) 
     25         jpnij = Agrif_Parent(jpnij) 
    3926         jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    4027         jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    4128         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    4229         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     30         jpk     = jpkdta 
    4331         jpim1   = jpi-1 
    4432         jpjm1   = jpj-1 
    … …  
    5543   END SUBROUTINE Agrif_InitWorkspace 
    5644 
    57 #if ! defined key_offline 
    5845 
    5946   SUBROUTINE Agrif_InitValues 
    … …  
    6754      USE dom_oce 
    6855      USE nemogcm 
    69 #if defined key_top 
    70       USE trc 
    71 #endif 
    7256#if defined key_tradmp   ||   defined key_esopa 
    7357      USE tradmp 
    … …  
    7660      USE obc_par 
    7761#endif 
    78       USE sol_oce 
    79       USE in_out_manager 
    80       USE agrif_opa_update 
    81       USE agrif_opa_interp 
    82       USE agrif_opa_sponge 
    83       USE agrif_top_update 
    84       USE agrif_top_interp 
    85       USE agrif_top_sponge 
    86       !! 
    87       IMPLICIT NONE 
    88       !! 
    89       REAL(wp) :: tabtemp(jpi,jpj,jpk) 
    90 #if defined key_top 
    91       REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 
    92 #endif  
    93       LOGICAL check_namelist 
     62      IMPLICIT NONE 
    9463      !!---------------------------------------------------------------------- 
    9564 
    … …  
    11180#endif 
    11281 
    113       Call nemo_init  ! Initializations of each fine grid 
    114       Call agrif_nemo_init 
    115  
     82      CALL nemo_init  ! Initializations of each fine grid 
     83      CALL agrif_nemo_init 
     84# if ! defined key_offline 
     85      CALL Agrif_InitValues_cont 
     86# endif        
     87# if defined key_top 
     88      CALL Agrif_InitValues_cont_top 
     89# endif       
     90   END SUBROUTINE Agrif_initvalues 
     91 
     92# if ! defined key_offline 
     93 
     94   SUBROUTINE Agrif_InitValues_cont 
     95      !!---------------------------------------------------------------------- 
     96      !!                 *** ROUTINE Agrif_InitValues_cont *** 
     97      !! 
     98      !! ** Purpose ::   Declaration of variables to be interpolated 
     99      !!---------------------------------------------------------------------- 
     100      USE Agrif_Util 
     101      USE oce  
     102      USE dom_oce 
     103      USE nemogcm 
     104      USE sol_oce 
     105      USE in_out_manager 
     106      USE agrif_opa_update 
     107      USE agrif_opa_interp 
     108      USE agrif_opa_sponge 
     109      ! 
     110      IMPLICIT NONE 
     111      ! 
     112      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp 
     113      LOGICAL :: check_namelist 
     114      !!---------------------------------------------------------------------- 
     115 
     116      ALLOCATE( tabtemp(jpi,jpj,jpk) ) 
     117       
     118       
    116119      ! 1. Declaration of the type of variable which have to be interpolated 
    117120      !--------------------------------------------------------------------- 
    118       Call Agrif_Set_type(un,(/1,2,0/),(/2,3,0/)) 
    119       Call Agrif_Set_type(vn,(/2,1,0/),(/3,2,0/)) 
    120  
    121       Call Agrif_Set_type(ua,(/1,2,0/),(/2,3,0/)) 
    122       Call Agrif_Set_type(va,(/2,1,0/),(/3,2,0/)) 
    123  
    124       Call Agrif_Set_type(e1u,(/1,2/),(/2,3/)) 
    125       Call Agrif_Set_type(e2v,(/2,1/),(/3,2/)) 
    126  
    127       Call Agrif_Set_type(tn,(/2,2,0/),(/3,3,0/)) 
    128       Call Agrif_Set_type(sn,(/2,2,0/),(/3,3,0/))  
    129  
    130       Call Agrif_Set_type(tb,(/2,2,0/),(/3,3,0/)) 
    131       Call Agrif_Set_type(sb,(/2,2,0/),(/3,3,0/))  
    132  
    133       Call Agrif_Set_type(ta,(/2,2,0/),(/3,3,0/)) 
    134       Call Agrif_Set_type(sa,(/2,2,0/),(/3,3,0/))        
    135  
    136       Call Agrif_Set_type(sshn,(/2,2/),(/3,3/)) 
    137       Call Agrif_Set_type(gcb,(/2,2/),(/3,3/)) 
    138  
    139 #if defined key_top 
    140       Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/)) 
    141       Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/)) 
    142       Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) 
    143 #endif 
    144        
    145       ! 2. Space directions for each variables 
    146       !--------------------------------------- 
    147       Call Agrif_Set_raf(un,(/'x','y','N'/)) 
    148       Call Agrif_Set_raf(vn,(/'x','y','N'/)) 
    149  
    150       Call Agrif_Set_raf(ua,(/'x','y','N'/)) 
    151       Call Agrif_Set_raf(va,(/'x','y','N'/)) 
    152  
    153       Call Agrif_Set_raf(e1u,(/'x','y'/)) 
    154       Call Agrif_Set_raf(e2v,(/'x','y'/)) 
    155  
    156       Call Agrif_Set_raf(tn,(/'x','y','N'/)) 
    157       Call Agrif_Set_raf(sn,(/'x','y','N'/)) 
    158  
    159       Call Agrif_Set_raf(tb,(/'x','y','N'/)) 
    160       Call Agrif_Set_raf(sb,(/'x','y','N'/)) 
    161  
    162       Call Agrif_Set_raf(ta,(/'x','y','N'/)) 
    163       Call Agrif_Set_raf(sa,(/'x','y','N'/))       
    164  
    165       Call Agrif_Set_raf(sshn,(/'x','y'/)) 
    166       Call Agrif_Set_raf(gcb,(/'x','y'/)) 
    167  
    168 #if defined key_top 
    169       Call Agrif_Set_raf(trn,(/'x','y','N','N'/)) 
    170       Call Agrif_Set_raf(trb,(/'x','y','N','N'/)) 
    171       Call Agrif_Set_raf(tra,(/'x','y','N','N'/)) 
    172 #endif 
    173  
    174       ! 3. Type of interpolation 
    175       !-------------------------  
    176       Call Agrif_Set_bcinterp(tn,interp=AGRIF_linear) 
    177       Call Agrif_Set_bcinterp(sn,interp=AGRIF_linear) 
    178  
    179       Call Agrif_Set_bcinterp(ta,interp=AGRIF_linear) 
    180       Call Agrif_Set_bcinterp(sa,interp=AGRIF_linear) 
    181  
    182       Call Agrif_Set_bcinterp(un,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    183       Call Agrif_Set_bcinterp(vn,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    184  
    185       Call Agrif_Set_bcinterp(ua,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    186       Call Agrif_Set_bcinterp(va,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    187  
    188       Call Agrif_Set_bcinterp(e1u,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    189       Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    190  
    191 #if defined key_top 
    192       Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) 
    193       Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) 
    194 #endif 
    195  
    196       ! 4. Location of interpolation 
    197       !----------------------------- 
    198       Call Agrif_Set_bc(un,(/0,1/)) 
    199       Call Agrif_Set_bc(vn,(/0,1/)) 
    200  
    201       Call Agrif_Set_bc(e1u,(/0,0/)) 
    202       Call Agrif_Set_bc(e2v,(/0,0/)) 
    203  
    204       Call Agrif_Set_bc(tn,(/0,1/)) 
    205       Call Agrif_Set_bc(sn,(/0,1/)) 
    206  
    207       Call Agrif_Set_bc(ta,(/-3*Agrif_irhox(),0/)) 
    208       Call Agrif_Set_bc(sa,(/-3*Agrif_irhox(),0/)) 
    209  
    210       Call Agrif_Set_bc(ua,(/-2*Agrif_irhox(),0/)) 
    211       Call Agrif_Set_bc(va,(/-2*Agrif_irhox(),0/)) 
    212  
    213 #if defined key_top 
    214       Call Agrif_Set_bc(trn,(/0,1/)) 
    215       Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) 
    216 #endif 
    217  
    218       ! 5. Update type 
    219       !---------------  
    220       Call Agrif_Set_Updatetype(tn, update = AGRIF_Update_Average) 
    221       Call Agrif_Set_Updatetype(sn, update = AGRIF_Update_Average) 
    222  
    223       Call Agrif_Set_Updatetype(tb, update = AGRIF_Update_Average) 
    224       Call Agrif_Set_Updatetype(sb, update = AGRIF_Update_Average) 
    225  
    226       Call Agrif_Set_Updatetype(sshn, update = AGRIF_Update_Average) 
    227       Call Agrif_Set_Updatetype(gcb,update = AGRIF_Update_Average) 
    228  
    229 #if defined key_top 
    230       Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) 
    231       Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) 
    232 #endif 
    233  
    234       Call Agrif_Set_Updatetype(un,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    235       Call Agrif_Set_Updatetype(vn,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    236  
    237       Call Agrif_Set_Updatetype(e1u,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    238       Call Agrif_Set_Updatetype(e2v,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    239  
    240       ! 6. First interpolations of potentially non zero fields 
     121      CALL agrif_declare_var 
     122 
     123      ! 2. First interpolations of potentially non zero fields 
    241124      !------------------------------------------------------- 
    242125      Agrif_SpecialValue=0. 
    243126      Agrif_UseSpecialValue = .TRUE. 
    244       Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.) 
    245       Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.) 
    246       Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu) 
    247       Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv) 
    248  
    249       Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn) 
    250       Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn) 
    251  
    252       Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun) 
    253       Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn) 
    254  
    255 #if defined key_top 
    256       Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 
    257       Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 
    258 #endif 
     127      Call Agrif_Bc_variable(tabtemp,tn_id,calledweight=1.,procname=interptn) 
     128     
     129      Call Agrif_Bc_variable(tabtemp,sn_id,calledweight=1.,procname=interpsn) 
     130      Call Agrif_Bc_variable(tabtemp,un_id,calledweight=1.,procname=interpu) 
     131      Call Agrif_Bc_variable(tabtemp,vn_id,calledweight=1.,procname=interpv) 
     132 
     133      Call Agrif_Bc_variable(tabtemp,ta_id,calledweight=1.,procname=interptn) 
     134      Call Agrif_Bc_variable(tabtemp,sa_id,calledweight=1.,procname=interpsn) 
     135 
     136      Call Agrif_Bc_variable(tabtemp,ua_id,calledweight=1.,procname=interpun) 
     137      Call Agrif_Bc_variable(tabtemp,va_id,calledweight=1.,procname=interpvn) 
    259138      Agrif_UseSpecialValue = .FALSE. 
    260139 
    261       ! 7. Some controls 
     140      ! 3. Some controls 
    262141      !----------------- 
    263142      check_namelist = .true. 
    … …  
    265144      IF( check_namelist ) THEN 
    266145      
     146         ! Check time steps            
     147         IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
     148            WRITE(*,*) 'incompatible time step between grids' 
     149            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
     150            WRITE(*,*) 'child  grid value : ',nint(rdt) 
     151            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     152            STOP 
     153         ENDIF 
     154          
     155         ! Check run length 
     156         IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) /= (nitend-nit000+1) ) THEN 
     157            WRITE(*,*) 'incompatible run length between grids' 
     158            WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step' 
     159            WRITE(*,*) 'child  grid value : ', (nitend-nit000+1),' time step' 
     160            WRITE(*,*) 'value on child grid should be: ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) 
     161            STOP 
     162         ENDIF 
     163          
     164         ! Check coordinates 
     165         IF( ln_zps ) THEN 
     166            ! check parameters for partial steps  
     167            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     168               WRITE(*,*) 'incompatible e3zps_min between grids' 
     169               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     170               WRITE(*,*) 'child grid  :',e3zps_min 
     171               WRITE(*,*) 'those values should be identical' 
     172               STOP 
     173            ENDIF           
     174            IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
     175               WRITE(*,*) 'incompatible e3zps_rat between grids' 
     176               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     177               WRITE(*,*) 'child grid  :',e3zps_rat 
     178               WRITE(*,*) 'those values should be identical'                   
     179               STOP 
     180            ENDIF 
     181         ENDIF 
     182      ENDIF 
     183        
     184      CALL Agrif_Update_tra(0) 
     185      CALL Agrif_Update_dyn(0) 
     186 
     187      nbcline = 0 
     188      ! 
     189      DEALLOCATE(tabtemp) 
     190      ! 
     191   END SUBROUTINE Agrif_InitValues_cont 
     192 
     193 
     194   SUBROUTINE agrif_declare_var 
     195      !!---------------------------------------------------------------------- 
     196      !!                 *** ROUTINE agrif_declarE_var *** 
     197      !! 
     198      !! ** Purpose :: Declaration of variables to be interpolated 
     199      !!---------------------------------------------------------------------- 
     200      USE agrif_util 
     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/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tn_id) 
     208      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sn_id) 
     209      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tb_id) 
     210      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sb_id) 
     211      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ta_id) 
     212      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sa_id) 
     213          
     214      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
     215      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
     216      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
     217      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
     218    
     219      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     220      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
     221 
     222      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
     223      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
     224        
     225      ! 2. Type of interpolation 
     226      !------------------------- 
     227      CALL Agrif_Set_bcinterp(tn_id,interp=AGRIF_linear) 
     228      CALL Agrif_Set_bcinterp(sn_id,interp=AGRIF_linear) 
     229      CALL Agrif_Set_bcinterp(ta_id,interp=AGRIF_linear) 
     230      CALL Agrif_Set_bcinterp(sa_id,interp=AGRIF_linear) 
     231    
     232      Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     233      Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     234 
     235      Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     236      Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     237 
     238      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     239      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     240 
     241      ! 3. Location of interpolation 
     242      !----------------------------- 
     243      Call Agrif_Set_bc(un_id,(/0,1/)) 
     244      Call Agrif_Set_bc(vn_id,(/0,1/)) 
     245 
     246      Call Agrif_Set_bc(e1u_id,(/0,0/)) 
     247      Call Agrif_Set_bc(e2v_id,(/0,0/)) 
     248 
     249      Call Agrif_Set_bc(tn_id,(/0,1/)) 
     250      Call Agrif_Set_bc(sn_id,(/0,1/)) 
     251 
     252      Call Agrif_Set_bc(ta_id,(/-3*Agrif_irhox(),0/)) 
     253      Call Agrif_Set_bc(sa_id,(/-3*Agrif_irhox(),0/)) 
     254 
     255      Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
     256      Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
     257 
     258      ! 5. Update type 
     259      !---------------  
     260      Call Agrif_Set_Updatetype(tn_id, update = AGRIF_Update_Average) 
     261      Call Agrif_Set_Updatetype(sn_id, update = AGRIF_Update_Average) 
     262 
     263      Call Agrif_Set_Updatetype(tb_id, update = AGRIF_Update_Average) 
     264      Call Agrif_Set_Updatetype(sb_id, update = AGRIF_Update_Average) 
     265 
     266      Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     267      Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
     268 
     269      Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     270      Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     271 
     272      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     273      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     274 
     275   END SUBROUTINE agrif_declare_var 
     276# endif 
     277    
     278# if defined key_top 
     279   SUBROUTINE Agrif_InitValues_cont_top 
     280      !!---------------------------------------------------------------------- 
     281      !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
     282      !! 
     283      !! ** Purpose :: Declaration of variables to be interpolated 
     284      !!---------------------------------------------------------------------- 
     285      USE Agrif_Util 
     286      USE oce  
     287      USE dom_oce 
     288      USE nemogcm 
     289      USE trc 
     290      USE in_out_manager 
     291      USE agrif_top_update 
     292      USE agrif_top_interp 
     293      USE agrif_top_sponge 
     294      ! 
     295      IMPLICIT NONE 
     296      ! 
     297      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
     298      LOGICAL :: check_namelist 
     299      !!---------------------------------------------------------------------- 
     300 
     301      ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
     302       
     303       
     304      ! 1. Declaration of the type of variable which have to be interpolated 
     305      !--------------------------------------------------------------------- 
     306      CALL agrif_declare_var_top 
     307 
     308      ! 2. First interpolations of potentially non zero fields 
     309      !------------------------------------------------------- 
     310      Agrif_SpecialValue=0. 
     311      Agrif_UseSpecialValue = .TRUE. 
     312      Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.) 
     313      Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
     314      Agrif_UseSpecialValue = .FALSE. 
     315 
     316      ! 3. Some controls 
     317      !----------------- 
     318      check_namelist = .true. 
     319             
     320      IF( check_namelist ) THEN 
     321#  if defined offline      
    267322         ! Check time steps            
    268323         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
    … …  
    275330          
    276331         ! Check run length 
    277          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    278             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     332         IF( Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    279333            WRITE(*,*) 'incompatible run length between grids' 
    280             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    281                Agrif_Parent(nit000)+1),' time step' 
    282             WRITE(*,*) 'child  grid value : ', & 
    283                (nitend-nit000+1),' time step' 
    284             WRITE(*,*) 'value on child grid should be : ', & 
    285                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    286                Agrif_Parent(nit000)+1) 
     334            WRITE(*,*) 'parent grid value : ', (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1),' time step' 
     335            WRITE(*,*) 'child  grid value : ', (nitend-nit000+1),' time step' 
     336            WRITE(*,*) 'value on child grid should be : ', Agrif_IRhot() * (Agrif_Parent(nitend)-Agrif_Parent(nit000)+1) 
    287337            STOP 
    288338         ENDIF 
    … …  
    306356            ENDIF 
    307357         ENDIF 
    308 #if defined key_top 
     358#  endif          
    309359        ! Check passive tracer cell 
    310360        IF( nn_dttrc .ne. 1 ) THEN 
    311361           WRITE(*,*) 'nn_dttrc should be equal to 1' 
    312362        ENDIF 
    313 #endif 
    314  
    315363      ENDIF 
    316  
    317 #if defined key_top 
     364        
    318365      CALL Agrif_Update_trc(0) 
    319 #endif 
    320       CALL Agrif_Update_tra(0) 
    321       CALL Agrif_Update_dyn(0) 
    322  
    323 #if defined key_top 
    324366      nbcline_trc = 0 
    325 #endif 
    326       nbcline = 0 
    327       ! 
    328    END SUBROUTINE Agrif_InitValues 
    329  
    330 #else 
    331  
    332    SUBROUTINE Agrif_InitValues 
    333       !!---------------------------------------------------------------------- 
    334       !!                 *** ROUTINE Agrif_InitValues *** 
     367      ! 
     368      DEALLOCATE(tabtrtemp) 
     369      ! 
     370   END SUBROUTINE Agrif_InitValues_cont_top 
     371 
     372 
     373   SUBROUTINE agrif_declare_var_top 
     374      !!---------------------------------------------------------------------- 
     375      !!                 *** ROUTINE agrif_declare_var_top *** 
    335376      !! 
    336       !! ** Purpose :: Declaration of variables to be interpolated 
    337       !!---------------------------------------------------------------------- 
    338       USE Agrif_Util 
    339       USE oce  
     377      !! ** Purpose :: Declaration of TOP variables to be interpolated 
     378      !!---------------------------------------------------------------------- 
     379      USE agrif_util 
    340380      USE dom_oce 
    341       USE nemogcm 
    342381      USE trc 
    343       USE in_out_manager 
    344       USE agrif_top_update 
    345       USE agrif_top_interp 
    346       USE agrif_top_sponge 
    347       !! 
    348       IMPLICIT NONE 
    349       !! 
    350       REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 
    351       LOGICAL check_namelist 
    352       !!---------------------------------------------------------------------- 
    353  
    354       ! 0. Initializations 
    355       !------------------- 
    356 #if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 
    357       jp_cfg = -1    ! set special value for jp_cfg on fine grids 
    358       cp_cfg = "default" 
    359 #endif 
    360  
    361       Call nemo_init  ! Initializations of each fine grid 
    362       Call agrif_nemo_init 
    363  
     382       
     383      IMPLICIT NONE 
     384    
    364385      ! 1. Declaration of the type of variable which have to be interpolated 
    365386      !--------------------------------------------------------------------- 
    366       Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/)) 
    367       Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/)) 
    368       Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/)) 
    369        
    370       ! 2. Space directions for each variables 
    371       !--------------------------------------- 
    372       Call Agrif_Set_raf(trn,(/'x','y','N','N'/)) 
    373       Call Agrif_Set_raf(trb,(/'x','y','N','N'/)) 
    374       Call Agrif_Set_raf(tra,(/'x','y','N','N'/)) 
    375  
    376       ! 3. Type of interpolation 
    377       !-------------------------  
    378       Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) 
    379       Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) 
    380  
    381       ! 4. Location of interpolation 
     387      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
     388      &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     389      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
     390      &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
     391      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0,jptra/),(/'x','y','N','N'/),  & 
     392      &                           (/1,1,1,1/),(/jpi,jpj,jpk/),tra_id) 
     393             
     394#  if defined key_offline 
     395      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     396      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
     397#  endif 
     398        
     399      ! 2. Type of interpolation 
     400      !------------------------- 
     401      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
     402      CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 
     403    
     404#  if defined key_offline 
     405      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     406      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     407#  endif 
     408 
     409      ! 3. Location of interpolation 
    382410      !----------------------------- 
    383       Call Agrif_Set_bc(trn,(/0,1/)) 
    384       Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) 
     411#  if defined key_offline 
     412      Call Agrif_Set_bc(e1u_id,(/0,0/)) 
     413      Call Agrif_Set_bc(e2v_id,(/0,0/)) 
     414#  endif 
     415      Call Agrif_Set_bc(trn_id,(/0,1/)) 
     416      Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 
    385417 
    386418      ! 5. Update type 
    387419      !---------------  
    388       Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) 
    389       Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) 
    390  
    391       ! 6. First interpolations of potentially non zero fields 
    392       !------------------------------------------------------- 
    393       Agrif_SpecialValue=0. 
    394       Agrif_UseSpecialValue = .TRUE. 
    395       Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 
    396       Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 
    397       Agrif_UseSpecialValue = .FALSE. 
    398  
    399       ! 7. Some controls 
    400       !----------------- 
    401       check_namelist = .true. 
    402              
    403       IF( check_namelist ) THEN 
    404       
    405          ! Check time steps            
    406          IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
    407             WRITE(*,*) 'incompatible time step between grids' 
    408             WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    409             WRITE(*,*) 'child  grid value : ',nint(rdt) 
    410             WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    411             STOP 
    412          ENDIF 
    413           
    414          ! Check run length 
    415          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    416             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    417             WRITE(*,*) 'incompatible run length between grids' 
    418             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    419                Agrif_Parent(nit000)+1),' time step' 
    420             WRITE(*,*) 'child  grid value : ', & 
    421                (nitend-nit000+1),' time step' 
    422             WRITE(*,*) 'value on child grid should be : ', & 
    423                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    424                Agrif_Parent(nit000)+1) 
    425             STOP 
    426          ENDIF 
    427           
    428          ! Check coordinates 
    429          IF( ln_zps ) THEN 
    430             ! check parameters for partial steps  
    431             IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
    432                WRITE(*,*) 'incompatible e3zps_min between grids' 
    433                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    434                WRITE(*,*) 'child grid  :',e3zps_min 
    435                WRITE(*,*) 'those values should be identical' 
    436                STOP 
    437             ENDIF           
    438             IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
    439                WRITE(*,*) 'incompatible e3zps_rat between grids' 
    440                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    441                WRITE(*,*) 'child grid  :',e3zps_rat 
    442                WRITE(*,*) 'those values should be identical'                   
    443                STOP 
    444             ENDIF 
    445          ENDIF 
    446         ! Check passive tracer cell 
    447         IF( nn_dttrc .ne. 1 ) THEN 
    448            WRITE(*,*) 'nn_dttrc should be equal to 1' 
    449         ENDIF 
    450  
    451       ENDIF 
    452  
    453       CALL Agrif_Update_trc(0) 
    454       nbcline_trc = 0 
    455       ! 
    456    END SUBROUTINE Agrif_InitValues 
    457  
    458 #endif 
    459     
    460    SUBROUTINE Agrif_detect( g, sizex ) 
     420      Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
     421      Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 
     422 
     423#  if defined key_offline 
     424      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     425      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     426#  endif 
     427 
     428   END SUBROUTINE agrif_declare_var_top 
     429# endif 
     430    
     431   SUBROUTINE Agrif_detect( kg, ksizex ) 
    461432      !!---------------------------------------------------------------------- 
    462433      !!   *** ROUTINE Agrif_detect *** 
    463434      !!---------------------------------------------------------------------- 
    464435      USE Agrif_Types 
    465       !!  
    466       INTEGER, DIMENSION(2) :: sizex 
    467       INTEGER, DIMENSION(sizex(1),sizex(2)) :: g  
     436      ! 
     437      INTEGER, DIMENSION(2) :: ksizex 
     438      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    468439      !!---------------------------------------------------------------------- 
    469440      ! 
    … …  
    479450      USE agrif_oce  
    480451      USE in_out_manager 
    481       !! 
    482       IMPLICIT NONE 
    483       !! 
     452      USE lib_mpp 
     453      IMPLICIT NONE 
     454      ! 
    484455      NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
    485456      !!---------------------------------------------------------------------- 
    … …  
    505476      visc_dyn      = rn_sponge_dyn 
    506477      ! 
     478      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     479      ! 
    507480    END SUBROUTINE agrif_nemo_init 
    508481 
    … …  
    514487      !!---------------------------------------------------------------------- 
    515488      USE dom_oce 
    516       !! 
    517       IMPLICIT NONE 
    518       !! 
    519       INTEGER :: indglob,indloc,nprocloc,i 
     489      IMPLICIT NONE 
     490      ! 
     491      INTEGER :: indglob, indloc, nprocloc, i 
    520492      !!---------------------------------------------------------------------- 
    521493      ! 
    … …  
    534506   SUBROUTINE Subcalledbyagrif 
    535507      !!---------------------------------------------------------------------- 
    536       !!   *** ROUTINE Subcalledbyagrif *** 
     508      !!                   *** ROUTINE Subcalledbyagrif *** 
    537509      !!---------------------------------------------------------------------- 
    538510      WRITE(*,*) 'Impossible to be here' 
Note: See TracChangeset for help on using the changeset viewer.