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 2677 for branches – NEMO

Changeset 2677 for branches


Ignore:
Timestamp:
2011-03-09T15:39:40+01:00 (13 years ago)
Author:
rblod
Message:

Commit in NST_SRC for agrif and dynamic memory

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r2528 r2677  
    1414    
    1515   IMPLICIT NONE 
    16    PUBLIC  
     16   PRIVATE  
     17 
     18   PUBLIC agrif_oce_alloc ! routine called by nemo_init in nemogcm.F90 
    1719 
    1820   !                                              !!* Namelist namagrif: AGRIF parameters 
    1921   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: 
    2022   INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency  
    21    REAL(wp), PUBLIC ::   rn_sponge_tra = rdt       !: sponge coeff. for tracers 
    22    REAL(wp), PUBLIC ::   rn_sponge_dyn = rdt       !: sponge coeff. for dynamics 
     23   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.       !: sponge coeff. for tracers 
     24   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.       !: sponge coeff. for dynamics 
    2325 
    2426   !                                              !!! OLD namelist names 
    … …  
    2931   LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator 
    3032   LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator 
    31    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   spe1ur, spe2vr ,spbtr2, spe1ur2, spe2vr2, spbtr3   !: ??? 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur, spe2vr ,spbtr2, spe1ur2, spe2vr2, spbtr3   !: ??? 
     34    
     35   INTEGER :: tn_id,sn_id,tb_id,sb_id,ta_id,sa_id 
     36   INTEGER :: un_id, vn_id, ua_id, va_id 
     37   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 
     38   INTEGER :: trn_id, trb_id, tra_id 
     39 
     40   CONTAINS  
     41 
     42   FUNCTION agrif_oce_alloc() 
     43     IMPLICIT none 
     44     INTEGER :: agrif_oce_alloc 
     45     INTEGER :: ierr 
     46 
     47     ALLOCATE(spe1ur (jpi,jpj), spe2vr (jpi,jpj), spbtr2(jpi,jpj), & 
     48              spe1ur2(jpi,jpj), spe2vr2(jpi,jpj), spbtr3(jpi,jpj),  & 
     49              Stat = ierr )  
     50 
     51      agrif_oce_alloc = ierr  
     52 
     53   END FUNCTION agrif_oce_alloc 
    3254 
    3355#endif 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r2528 r2677  
    2525   USE phycst 
    2626   USE in_out_manager 
     27   USE agrif_opa_sponge 
     28   USE lib_mpp 
    2729 
    2830   IMPLICIT NONE 
    … …  
    4547      !!                  ***  ROUTINE Agrif_Tra  *** 
    4648      !!---------------------------------------------------------------------- 
     49      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     50      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     51      !! 
    4752      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    4853      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3 
    4954      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7 
    50       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zta, zsa   ! 3D workspace 
     55      REAL(wp), POINTER, DIMENSION(:,:,:) :: zta, zsa 
    5156      !!---------------------------------------------------------------------- 
    5257      ! 
    5358      IF( Agrif_Root() )   RETURN 
     59 
     60      zta => wrk_3d_1 ; zsa => wrk_3d_2 
     61      IF( wrk_in_use(3, 1,2) )THEN 
     62         CALL ctl_stop('agrif_tra: requested workspace arrays unavailable.') 
     63         RETURN 
     64      END IF 
    5465 
    5566      Agrif_SpecialValue    = 0.e0 
    … …  
    5869      zsa(:,:,:) = 0.e0 
    5970 
    60       CALL Agrif_Bc_variable( zta, tn ) 
    61       CALL Agrif_Bc_variable( zsa, sn ) 
     71      CALL Agrif_Bc_variable( zta, tn_id, procname = interptn ) 
     72      CALL Agrif_Bc_variable( zsa, sn_id, procname = interpsn ) 
    6273      Agrif_UseSpecialValue = .FALSE. 
    6374 
    … …  
    162173      ENDIF 
    163174      ! 
     175      IF( wrk_not_released(3, 1,2) ) THEN 
     176         CALL ctl_stop('agrif_tra: failed to release workspace arrays.') 
     177      ENDIF 
     178      ! 
    164179   END SUBROUTINE Agrif_tra 
    165180 
    … …  
    169184      !!                  ***  ROUTINE Agrif_DYN  *** 
    170185      !!----------------------------------------------------------------------   
     186      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     187      USE wrk_nemo, ONLY: wrk_2d_4, wrk_2d_5 
     188      USE wrk_nemo, ONLY: wrk_2d_6, wrk_2d_7 
     189      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     190      !!  
    171191      INTEGER, INTENT(in) ::   kt 
    172192      !! 
    … …  
    175195      REAL(wp) :: z2dt, znugdt 
    176196      REAL(wp) :: zrhox, rhoy 
    177       REAL(wp), DIMENSION(jpi,jpj) :: zua2d, zva2d 
    178       REAL(wp), DIMENSION(jpi,jpj) :: spgu1,spgv1 
    179       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zua, zva 
     197      REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva 
     198      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d 
    180199      !!----------------------------------------------------------------------   
    181200 
    182201      IF( Agrif_Root() )   RETURN 
     202 
     203      spgu1  => wrk_2d_4 ; spgv1 => wrk_2d_5 
     204      zua2d  => wrk_2d_6 ; zva2d => wrk_2d_7 
     205      zua  => wrk_3d_1 ; zva => wrk_3d_2 
     206      IF( wrk_in_use(2, 4,5,6,7) .OR. wrk_in_use(3, 1,2) )THEN 
     207         CALL ctl_stop('agrif_dyn: requested workspace arrays unavailable.') 
     208         RETURN 
     209      END IF 
    183210 
    184211      zrhox = Agrif_Rhox() 
    … …  
    199226      zua = 0. 
    200227      zva = 0. 
    201       CALL Agrif_Bc_variable(zua,un,procname=interpu) 
    202       CALL Agrif_Bc_variable(zva,vn,procname=interpv) 
     228      CALL Agrif_Bc_variable(zua,un_id,procname=interpu) 
     229      CALL Agrif_Bc_variable(zva,vn_id,procname=interpv) 
    203230      zua2d = 0. 
    204231      zva2d = 0. 
    … …  
    206233      Agrif_SpecialValue=0. 
    207234      Agrif_UseSpecialValue = ln_spc_dyn 
    208       CALL Agrif_Bc_variable(zua2d,e1u,calledweight=1.,procname=interpu2d) 
    209       CALL Agrif_Bc_variable(zva2d,e2v,calledweight=1.,procname=interpv2d) 
     235      CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d) 
     236      CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d) 
    210237      Agrif_UseSpecialValue = .FALSE. 
    211238 
    … …  
    492519 
    493520      ENDIF 
    494  
     521      ! 
     522      IF( wrk_not_released(3, 1,2) .OR. wrk_not_released(2, 4,5,6,7)) THEN 
     523         CALL ctl_stop('agrif_dyn: failed to release workspace arrays.') 
     524      ENDIF 
     525      ! 
    495526   END SUBROUTINE Agrif_dyn 
    496527 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r2528 r2677  
    2727      !!--------------------------------------------- 
    2828#include "domzgr_substitute.h90" 
    29  
     29      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     30      USE wrk_nemo, ONLY: wrk_2d_1 
     31      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     32      USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4 
     33      USE wrk_nemo, ONLY: wrk_3d_7, wrk_3d_6 
     34      USE wrk_nemo, ONLY: wrk_3d_8 
     35      !! 
    3036      INTEGER :: ji,jj,jk 
    3137      INTEGER :: spongearea 
    3238      REAL(wp) :: timecoeff 
    3339      REAL(wp) :: zta, zsa, zabe1, zabe2, zbtr 
    34       REAL(wp), DIMENSION(jpi,jpj) :: localviscsponge 
    35       REAL(wp), DIMENSION(jpi,jpj,jpk) :: tbdiff, sbdiff 
    36       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu ,ztv, zsu ,zsv 
    37       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztab 
     40      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
     41      REAL(wp), POINTER, DIMENSION(:,:,:) :: tbdiff, sbdiff 
     42      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, zsu, ztv, zsv 
     43      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
    3844 
    3945#if defined SPONGE 
     46      localviscsponge => wrk_2d_1 
     47      tbdiff => wrk_3d_1 ;sbdiff => wrk_3d_2 
     48      ztu => wrk_3d_3 ; zsu => wrk_3d_4 
     49      ztv => wrk_3d_7 ; zsv => wrk_3d_6 
     50      ztab => wrk_3d_8 
    4051 
    4152      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    4455      Agrif_UseSpecialValue = .TRUE. 
    4556      ztab = 0.e0 
    46       CALL Agrif_Bc_Variable(ztab, ta,calledweight=timecoeff,procname=interptn) 
     57      CALL Agrif_Bc_Variable(ztab, ta_id,calledweight=timecoeff,procname=interptn) 
    4758      Agrif_UseSpecialValue = .FALSE. 
    4859 
    … …  
    5263      Agrif_SpecialValue=0. 
    5364      Agrif_UseSpecialValue = .TRUE. 
    54       CALL Agrif_Bc_Variable(ztab, sa,calledweight=timecoeff,procname=interpsn) 
     65      CALL Agrif_Bc_Variable(ztab, sa_id,calledweight=timecoeff,procname=interpsn) 
    5566      Agrif_UseSpecialValue = .FALSE. 
    5667 
    5768      sbdiff(:,:,:) = sb(:,:,:) - ztab(:,:,:) 
    58  
    5969 
    6070      spongearea = 2 + 2 * Agrif_irhox() 
    … …  
    164174      !!--------------------------------------------- 
    165175#include "domzgr_substitute.h90" 
    166  
     176      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     177      USE wrk_nemo, ONLY: wrk_2d_1 
     178      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     179      USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4 
     180      USE wrk_nemo, ONLY: wrk_3d_5 
     181      !! 
    167182      INTEGER :: ji,jj,jk 
    168183      INTEGER :: spongearea 
    169184      REAL(wp) :: timecoeff 
    170185      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
    171       REAL(wp), DIMENSION(jpi,jpj) :: localviscsponge 
    172       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztab, ubdiff, vbdiff,rotdiff,hdivdiff 
     186      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
     187      REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff 
     188      REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff 
     189      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
    173190 
    174191#if defined SPONGE 
     192      localviscsponge => wrk_2d_1 
     193      ubdiff => wrk_3d_1 ; vbdiff => wrk_3d_2 
     194      rotdiff => wrk_3d_3 ; hdivdiff => wrk_3d_4 
     195      ztab => wrk_3d_5 
    175196 
    176197      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    179200      Agrif_UseSpecialValue = ln_spc_dyn 
    180201      ztab = 0.e0 
    181       CALL Agrif_Bc_Variable(ztab, ua,calledweight=timecoeff,procname=interpun) 
     202      CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun) 
    182203      Agrif_UseSpecialValue = .FALSE. 
    183204 
    … …  
    187208      Agrif_SpecialValue=0. 
    188209      Agrif_UseSpecialValue = ln_spc_dyn 
    189       CALL Agrif_Bc_Variable(ztab, va,calledweight=timecoeff,procname=interpvn) 
     210      CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn) 
    190211      Agrif_UseSpecialValue = .FALSE. 
    191212 
    … …  
    250271         spongedoneU = .TRUE. 
    251272     
    252     spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:)) 
     273     spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:)) 
    253274      ENDIF 
    254275       

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r2528 r2677  
    77   USE dom_oce 
    88   USE agrif_oce 
     9   USE in_out_manager  ! I/O manager 
     10   USE lib_mpp 
    911 
    1012   IMPLICIT NONE 
    … …  
    2729      !!   *** ROUTINE Agrif_Update_Tra *** 
    2830      !!--------------------------------------------- 
     31      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     32      USE wrk_nemo, ONLY: wrk_3d_1 
     33      !! 
    2934      INTEGER, INTENT(in) :: kt 
    30  
    31       REAL :: ztab(jpi,jpj,jpk) 
    32  
     35      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
     36 
     37        
    3338      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    3439#if defined TWO_WAY 
     40      ztab => wrk_3d_1 
     41      IF( wrk_in_use(3, 1) ) THEN 
     42         CALL ctl_stop('agrif_update_tra: ERROR: requested workspace arrays unavailable') 
     43         RETURN 
     44      END IF 
     45 
    3546      Agrif_UseSpecialValueInUpdate = .TRUE. 
    3647      Agrif_SpecialValueFineGrid = 0. 
    3748 
    3849      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
    39          CALL Agrif_Update_Variable(ztab,tn, procname=updateT) 
    40          CALL Agrif_Update_Variable(ztab,sn, procname=updateS) 
    41       ELSE 
    42          CALL Agrif_Update_Variable(ztab,tn,locupdate=(/0,2/), procname=updateT) 
    43          CALL Agrif_Update_Variable(ztab,sn,locupdate=(/0,2/), procname=updateS) 
     50         CALL Agrif_Update_Variable(ztab,tn_id, procname=updateT) 
     51         CALL Agrif_Update_Variable(ztab,sn_id, procname=updateS) 
     52      ELSE 
     53         CALL Agrif_Update_Variable(ztab,tn_id,locupdate=(/0,2/), procname=updateT) 
     54         CALL Agrif_Update_Variable(ztab,sn_id,locupdate=(/0,2/), procname=updateS) 
    4455      ENDIF 
    4556 
    4657      Agrif_UseSpecialValueInUpdate = .FALSE. 
     58 
     59      IF( wrk_not_released(3, 1) ) THEN 
     60         CALL ctl_stop('Agrif_Update_Tra: ERROR: failed to release workspace arrays') 
     61      END IF 
    4762#endif 
    4863 
    … …  
    5368      !!   *** ROUTINE Agrif_Update_Dyn *** 
    5469      !!--------------------------------------------- 
     70      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     71      USE wrk_nemo, ONLY: wrk_2d_1 
     72      USE wrk_nemo, ONLY: wrk_3d_1 
     73      !! 
    5574      INTEGER, INTENT(in) :: kt 
    56  
    57       REAL(wp), DIMENSION(jpi,jpj) :: ztab2d 
    58       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztab 
     75      REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d 
     76      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
     77 
    5978 
    6079      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return 
    6180#if defined TWO_WAY 
     81      ztab => wrk_3d_1 ; ztab2d => wrk_2d_1 
     82      IF( ( wrk_in_use(2, 1)) .OR.  wrk_in_use(3, 1) )THEN 
     83         CALL ctl_stop('agrif_update_dyn: ERROR: requested workspace arrays unavailable') 
     84         RETURN 
     85      END IF 
    6286 
    6387      IF (mod(nbcline,nbclineupdate) == 0) THEN 
    64          CALL Agrif_Update_Variable(ztab,un,procname = updateU) 
    65          CALL Agrif_Update_Variable(ztab,vn,procname = updateV) 
    66       ELSE 
    67          CALL Agrif_Update_Variable(ztab,un,locupdate=(/0,1/),procname = updateU) 
    68          CALL Agrif_Update_Variable(ztab,vn,locupdate=(/0,1/),procname = updateV)          
    69       ENDIF 
    70  
    71       CALL Agrif_Update_Variable(ztab2d,e1u,procname = updateU2d) 
    72       CALL Agrif_Update_Variable(ztab2d,e2v,procname = updateV2d)   
     88         CALL Agrif_Update_Variable(ztab,un_id,procname = updateU) 
     89         CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV) 
     90      ELSE 
     91         CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU) 
     92         CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV)          
     93      ENDIF 
     94 
     95      CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d) 
     96      CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d)   
    7397 
    7498      nbcline = nbcline + 1 
    … …  
    76100      Agrif_UseSpecialValueInUpdate = ln_spc_dyn 
    77101      Agrif_SpecialValueFineGrid = 0. 
    78       CALL Agrif_Update_Variable(ztab2d,sshn,procname = updateSSH) 
     102      CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH) 
    79103      Agrif_UseSpecialValueInUpdate = .FALSE. 
    80104 
     105      IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )THEN 
     106         CALL ctl_stop('agrif_update_dyn: ERROR: failed to release workspace arrays') 
     107      END IF 
    81108 
    82109!Done in step 
    … …  
    184211               DO ji=i1,i2 
    185212                  tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
     213                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk) 
    186214               END DO 
    187215            END DO 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r2528 r2677  
    66   USE sol_oce 
    77   USE agrif_oce 
     8   USE agrif_top_sponge 
    89   USE trc 
     10   USE lib_mpp 
    911 
    1012   IMPLICIT NONE 
    … …  
    1315   PUBLIC Agrif_trc 
    1416 
    15    !!---------------------------------------------------------------------- 
     17#  include "domzgr_substitute.h90"   
     18#  include "vectopt_loop_substitute.h90" 
     19  !!---------------------------------------------------------------------- 
    1620   !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    1721   !! $Id$ 
    … …  
    2529      !!   *** ROUTINE Agrif_trc *** 
    2630      !!--------------------------------------------- 
    27 #  include "domzgr_substitute.h90"   
    28 #  include "vectopt_loop_substitute.h90" 
     31      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     32      USE wrk_nemo, ONLY: wrk_4d_1 
    2933       
    3034      INTEGER :: ji,jj,jk,jn 
    … …  
    3236      REAL(wp) :: alpha1, alpha2, alpha3, alpha4 
    3337      REAL(wp) :: alpha5, alpha6, alpha7 
    34       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztra 
    35        
     38      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 
     39            
    3640      IF (Agrif_Root()) RETURN 
     41 
     42      IF( wrk_in_use(4, 1) ) THEN 
     43         CALL ctl_stop('Agrif_trc : requested workspace arrays unavailable') 
     44         RETURN 
     45      ENDIF 
     46      ztra =>  wrk_4d_1(:,:,:,jptra) 
    3747 
    3848      Agrif_SpecialValue=0. 
    … …  
    4050      ztra = 0.e0 
    4151 
    42       CALL Agrif_Bc_variable(ztra,trn) 
     52      CALL Agrif_Bc_variable(ztra,trn_id, procname = interptrn ) 
    4353      Agrif_UseSpecialValue = .FALSE. 
    4454 
    … …  
    131141      ENDIF 
    132142 
     143      IF( wrk_not_released(4, 1) ) THEN 
     144         CALL ctl_stop('Agrif_trc : failed to release workspace arrays.') 
     145         RETURN 
     146      ENDIF 
     147 
    133148   END SUBROUTINE Agrif_trc 
    134149 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r2528 r2677  
    99   USE agrif_oce 
    1010   USE trc 
     11   USE lib_mpp 
    1112 
    1213   IMPLICIT NONE 
    … …  
    2829      !!--------------------------------------------- 
    2930#include "domzgr_substitute.h90" 
    30  
     31      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     32      USE wrk_nemo, ONLY: wrk_2d_1 
     33      USE wrk_nemo, ONLY: wrk_4d_1, wrk_4d_2, wrk_4d_3, wrk_4d_4 
     34      !!  
    3135      INTEGER :: ji,jj,jk,jl 
    3236      INTEGER :: spongearea 
    3337      REAL(wp) :: timecoeff 
    3438      REAL(wp) :: ztra, zabe1, zabe2, zbtr 
    35       REAL(wp), DIMENSION(jpi,jpj) :: localviscsponge 
    36       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: trbdiff 
    37       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztru ,ztrv 
    38       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::  ztab 
     39      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
     40      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab 
    3941 
    4042#if defined SPONGE_TOP 
     43      IF( wrk_in_use(4, 1,2,3,4) .OR. wrk_in_use(2, 1) ) THEN 
     44         CALL ctl_stop('Agrif_Sponge_trc : requested workspace arrays unavailable') 
     45         RETURN 
     46      ENDIF 
     47      localviscsponge => wrk_2d_1 
     48      trbdiff(:,:,:,:) => wrk_4d_1(:,:,:,1:jptra) 
     49      ztru   (:,:,:,:) => wrk_4d_2(:,:,:,1:jptra) 
     50      ztrv   (:,:,:,:) => wrk_4d_3(:,:,:,1:jptra) 
     51      ztab   (:,:,:,:) => wrk_4d_4(:,:,:,1:jptra) 
    4152 
    4253      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    4556      Agrif_UseSpecialValue = .TRUE. 
    4657      ztab = 0.e0 
    47       CALL Agrif_Bc_Variable(ztab, tra,calledweight=timecoeff,procname=interptrn) 
     58      CALL Agrif_Bc_Variable(ztab, tra_id,calledweight=timecoeff,procname=interptrn) 
    4859      Agrif_UseSpecialValue = .FALSE. 
    4960 
    … …  
    143154      ENDDO 
    144155      ENDDO 
     156  
     157      IF( wrk_not_released(4, 1,2,3,4) .OR. wrk_not_released(2, 1) ) THEN 
     158         CALL ctl_stop('Agrif_Sponge_trc : failed to release workspace arrays.') 
     159         RETURN 
     160      ENDIF 
    145161 
    146162#endif 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r2528 r2677  
    2929      !!   *** ROUTINE Agrif_Update_Trc *** 
    3030      !!--------------------------------------------- 
     31      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     32      USE wrk_nemo, ONLY: wrk_4d_1 
     33      !! 
    3134      INTEGER, INTENT(in) :: kt 
     35      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 
     36 
    3237   
    33       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztra 
    34  
    3538      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    3639 
    3740#if defined TWO_WAY 
     41      IF( wrk_in_use(4, 1) ) THEN 
     42         CALL ctl_stop('Agrif_Update_trc : requested workspace arrays unavailable') 
     43         RETURN 
     44      ENDIF 
     45      ztra =>  wrk_4d_1(:,:,:,jptra) 
     46 
    3847      Agrif_UseSpecialValueInUpdate = .TRUE. 
    3948      Agrif_SpecialValueFineGrid = 0. 
    4049  
    4150     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 
    42          CALL Agrif_Update_Variable(ztra,trn, procname=updateTRC) 
     51         CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC) 
    4352      ELSE 
    44          CALL Agrif_Update_Variable(ztra,trn,locupdate=(/0,2/), procname=updateTRC) 
     53         CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC) 
    4554      ENDIF 
    4655 
    4756      Agrif_UseSpecialValueInUpdate = .FALSE. 
    4857      nbcline_trc = nbcline_trc + 1 
     58 
     59      IF( wrk_not_released(4, 1) ) THEN 
     60         CALL ctl_stop('Agrif_Update_trc : failed to release workspace arrays.') 
     61         RETURN 
     62      ENDIF 
    4963#endif 
    5064 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r2528 r2677  
    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      !! 
    3821      IF( .NOT. Agrif_Root() ) THEN 
     22         jpni = Agrif_Parent(jpni) 
     23         jpnj = Agrif_Parent(jpnj) 
     24         jpnij = Agrif_Parent(jpnij) 
    3925         jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    4026         jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    4127         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    4228         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     29         jpk     = jpkdta 
    4330         jpim1   = jpi-1 
    4431         jpjm1   = jpj-1 
    … …  
    5542   END SUBROUTINE Agrif_InitWorkspace 
    5643 
    57 #if ! defined key_offline 
    5844 
    5945   SUBROUTINE Agrif_InitValues 
    … …  
    6753      USE dom_oce 
    6854      USE nemogcm 
    69 #if defined key_top 
    70       USE trc 
    71 #endif 
    7255#if defined key_tradmp   ||   defined key_esopa 
    7356      USE tradmp 
    … …  
    7659      USE obc_par 
    7760#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 
    94       !!---------------------------------------------------------------------- 
     61      !! 
     62      IMPLICIT NONE 
     63      !! 
    9564 
    9665      ! 0. Initializations 
    … …  
    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   SUBROUTINE Agrif_InitValues_cont 
     94      !!---------------------------------------------------------------------- 
     95      !!                 *** ROUTINE Agrif_InitValues_cont *** 
     96      !! 
     97      !! ** Purpose :: Declaration of variables to be interpolated 
     98      !!---------------------------------------------------------------------- 
     99      USE Agrif_Util 
     100      USE oce  
     101      USE dom_oce 
     102      USE nemogcm 
     103      USE sol_oce 
     104      USE in_out_manager 
     105      USE agrif_opa_update 
     106      USE agrif_opa_interp 
     107      USE agrif_opa_sponge 
     108      !! 
     109      IMPLICIT NONE 
     110      !! 
     111      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp 
     112      LOGICAL :: check_namelist 
     113      !!---------------------------------------------------------------------- 
     114 
     115      ALLOCATE(tabtemp(jpi, jpj, jpk)) 
     116       
     117       
    116118      ! 1. Declaration of the type of variable which have to be interpolated 
    117119      !--------------------------------------------------------------------- 
    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 
     120      CALL agrif_declare_var 
     121 
     122      ! 2. First interpolations of potentially non zero fields 
    241123      !------------------------------------------------------- 
    242124      Agrif_SpecialValue=0. 
    243125      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 
     126      Call Agrif_Bc_variable(tabtemp,tn_id,calledweight=1.,procname=interptn) 
     127     
     128      Call Agrif_Bc_variable(tabtemp,sn_id,calledweight=1.,procname=interpsn) 
     129      Call Agrif_Bc_variable(tabtemp,un_id,calledweight=1.,procname=interpu) 
     130      Call Agrif_Bc_variable(tabtemp,vn_id,calledweight=1.,procname=interpv) 
     131 
     132      Call Agrif_Bc_variable(tabtemp,ta_id,calledweight=1.,procname=interptn) 
     133      Call Agrif_Bc_variable(tabtemp,sa_id,calledweight=1.,procname=interpsn) 
     134 
     135      Call Agrif_Bc_variable(tabtemp,ua_id,calledweight=1.,procname=interpun) 
     136      Call Agrif_Bc_variable(tabtemp,va_id,calledweight=1.,procname=interpvn) 
    259137      Agrif_UseSpecialValue = .FALSE. 
    260138 
    261       ! 7. Some controls 
     139      ! 3. Some controls 
    262140      !----------------- 
    263141      check_namelist = .true. 
    … …  
    306184            ENDIF 
    307185         ENDIF 
    308 #if defined key_top 
    309         ! Check passive tracer cell 
    310         IF( nn_dttrc .ne. 1 ) THEN 
    311            WRITE(*,*) 'nn_dttrc should be equal to 1' 
    312         ENDIF 
    313 #endif 
    314  
    315186      ENDIF 
    316  
    317 #if defined key_top 
    318       CALL Agrif_Update_trc(0) 
    319 #endif 
     187        
    320188      CALL Agrif_Update_tra(0) 
    321189      CALL Agrif_Update_dyn(0) 
    322190 
    323 #if defined key_top 
    324       nbcline_trc = 0 
    325 #endif 
    326191      nbcline = 0 
    327192      ! 
    328    END SUBROUTINE Agrif_InitValues 
    329  
    330 #else 
    331  
    332    SUBROUTINE Agrif_InitValues 
    333       !!---------------------------------------------------------------------- 
    334       !!                 *** ROUTINE Agrif_InitValues *** 
     193      DEALLOCATE(tabtemp) 
     194      ! 
     195   END SUBROUTINE Agrif_InitValues_cont 
     196 
     197   SUBROUTINE agrif_declare_var 
     198      !!---------------------------------------------------------------------- 
     199      !!                 *** ROUTINE agrif_declarE_var *** 
     200      !! 
     201      !! ** Purpose :: Declaration of variables to be interpolated 
     202      !!---------------------------------------------------------------------- 
     203      USE agrif_util 
     204      USE oce 
     205      IMPLICIT NONE 
     206    
     207      ! 1. Declaration of the type of variable which have to be interpolated 
     208      !--------------------------------------------------------------------- 
     209      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tn_id) 
     210      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sn_id) 
     211      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tb_id) 
     212      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sb_id) 
     213      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ta_id) 
     214      CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sa_id) 
     215          
     216      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
     217      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
     218      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
     219      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
     220    
     221      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     222      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
     223 
     224      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
     225      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
     226        
     227      ! 2. Type of interpolation 
     228      !------------------------- 
     229      CALL Agrif_Set_bcinterp(tn_id,interp=AGRIF_linear) 
     230      CALL Agrif_Set_bcinterp(sn_id,interp=AGRIF_linear) 
     231      CALL Agrif_Set_bcinterp(ta_id,interp=AGRIF_linear) 
     232      CALL Agrif_Set_bcinterp(sa_id,interp=AGRIF_linear) 
     233    
     234      Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     235      Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     236 
     237      Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     238      Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     239 
     240      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     241      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     242 
     243      ! 3. Location of interpolation 
     244      !----------------------------- 
     245      Call Agrif_Set_bc(un_id,(/0,1/)) 
     246      Call Agrif_Set_bc(vn_id,(/0,1/)) 
     247 
     248      Call Agrif_Set_bc(e1u_id,(/0,0/)) 
     249      Call Agrif_Set_bc(e2v_id,(/0,0/)) 
     250 
     251      Call Agrif_Set_bc(tn_id,(/0,1/)) 
     252      Call Agrif_Set_bc(sn_id,(/0,1/)) 
     253 
     254      Call Agrif_Set_bc(ta_id,(/-3*Agrif_irhox(),0/)) 
     255      Call Agrif_Set_bc(sa_id,(/-3*Agrif_irhox(),0/)) 
     256 
     257      Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
     258      Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
     259 
     260      ! 5. Update type 
     261      !---------------  
     262      Call Agrif_Set_Updatetype(tn_id, update = AGRIF_Update_Average) 
     263      Call Agrif_Set_Updatetype(sn_id, update = AGRIF_Update_Average) 
     264 
     265      Call Agrif_Set_Updatetype(tb_id, update = AGRIF_Update_Average) 
     266      Call Agrif_Set_Updatetype(sb_id, update = AGRIF_Update_Average) 
     267 
     268      Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     269      Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
     270 
     271      Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     272      Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     273 
     274      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     275      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     276 
     277   END SUBROUTINE agrif_declare_var 
     278# endif 
     279    
     280# if defined key_top 
     281   SUBROUTINE Agrif_InitValues_cont_top 
     282      !!---------------------------------------------------------------------- 
     283      !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
    335284      !! 
    336285      !! ** Purpose :: Declaration of variables to be interpolated 
    … …  
    348297      IMPLICIT NONE 
    349298      !! 
    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  
     299      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
     300      LOGICAL :: check_namelist 
     301      !!---------------------------------------------------------------------- 
     302 
     303      ALLOCATE(tabtrtemp(jpi, jpj, jpk, jptra)) 
     304       
     305       
    364306      ! 1. Declaration of the type of variable which have to be interpolated 
    365307      !--------------------------------------------------------------------- 
    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 
    382       !----------------------------- 
    383       Call Agrif_Set_bc(trn,(/0,1/)) 
    384       Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) 
    385  
    386       ! 5. Update type 
    387       !---------------  
    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 
     308      CALL agrif_declare_var_top 
     309 
     310      ! 2. First interpolations of potentially non zero fields 
    392311      !------------------------------------------------------- 
    393312      Agrif_SpecialValue=0. 
    394313      Agrif_UseSpecialValue = .TRUE. 
    395       Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 
    396       Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn) 
     314      Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.) 
     315      Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
    397316      Agrif_UseSpecialValue = .FALSE. 
    398317 
    399       ! 7. Some controls 
     318      ! 3. Some controls 
    400319      !----------------- 
    401320      check_namelist = .true. 
    402321             
    403322      IF( check_namelist ) THEN 
    404       
     323#  if defined offline      
    405324         ! Check time steps            
    406325         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
    … …  
    444363            ENDIF 
    445364         ENDIF 
     365#  endif          
    446366        ! Check passive tracer cell 
    447367        IF( nn_dttrc .ne. 1 ) THEN 
    448368           WRITE(*,*) 'nn_dttrc should be equal to 1' 
    449369        ENDIF 
    450  
    451370      ENDIF 
    452  
     371        
    453372      CALL Agrif_Update_trc(0) 
    454373      nbcline_trc = 0 
    455374      ! 
    456    END SUBROUTINE Agrif_InitValues 
    457  
    458 #endif 
     375      DEALLOCATE(tabtrtemp) 
     376      ! 
     377   END SUBROUTINE Agrif_InitValues_cont_top 
     378 
     379 
     380   SUBROUTINE agrif_declare_var_top 
     381      !!---------------------------------------------------------------------- 
     382      !!                 *** ROUTINE agrif_declare_var_top *** 
     383      !! 
     384      !! ** Purpose :: Declaration of TOP variables to be interpolated 
     385      !!---------------------------------------------------------------------- 
     386      USE agrif_util 
     387      USE dom_oce 
     388      USE trc 
     389       
     390      IMPLICIT NONE 
     391    
     392      ! 1. Declaration of the type of variable which have to be interpolated 
     393      !--------------------------------------------------------------------- 
     394      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
     395      &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     396      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
     397      &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
     398      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0,jptra/),(/'x','y','N','N'/),  & 
     399      &                           (/1,1,1,1/),(/jpi,jpj,jpk/),tra_id) 
     400             
     401#  if defined key_offline 
     402      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     403      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
     404#  endif 
     405        
     406      ! 2. Type of interpolation 
     407      !------------------------- 
     408      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
     409      CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 
     410    
     411#  if defined key_offline 
     412      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     413      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     414#  endif 
     415 
     416      ! 3. Location of interpolation 
     417      !----------------------------- 
     418#  if defined key_offline 
     419      Call Agrif_Set_bc(e1u_id,(/0,0/)) 
     420      Call Agrif_Set_bc(e2v_id,(/0,0/)) 
     421#  endif 
     422      Call Agrif_Set_bc(trn_id,(/0,1/)) 
     423      Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 
     424 
     425      ! 5. Update type 
     426      !---------------  
     427      Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
     428      Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 
     429 
     430#  if defined key_offline 
     431      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     432      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     433#  endif 
     434 
     435   END SUBROUTINE agrif_declare_var_top 
     436# endif 
    459437    
    460438   SUBROUTINE Agrif_detect( g, sizex ) 
    … …  
    479457      USE agrif_oce  
    480458      USE in_out_manager 
     459      USE lib_mpp 
    481460      !! 
    482461      IMPLICIT NONE 
    483462      !! 
    484463      NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
     464      INTEGER :: ierr 
    485465      !!---------------------------------------------------------------------- 
    486466      ! 
    … …  
    505485      visc_dyn      = rn_sponge_dyn 
    506486      ! 
     487      ierr = agrif_oce_alloc() 
     488      IF( ierr  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     489      ! 
    507490    END SUBROUTINE agrif_nemo_init 
    508491 
Note: See TracChangeset for help on using the changeset viewer.