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

Location:
trunk/NEMOGCM/NEMO/NST_SRC
Files:
8 edited

Legend:

Unmodified
Added
Removed

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

    r2528 r2715  
    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 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ??? 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ??? 
     36    
     37   INTEGER :: tn_id, sn_id, tb_id, sb_id, ta_id, sa_id 
     38   INTEGER :: un_id, vn_id, ua_id, va_id 
     39   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 
     40   INTEGER :: trn_id, trb_id, tra_id 
     41 
     42   !!---------------------------------------------------------------------- 
     43   !! NEMO/NST 3.3.1 , NEMO Consortium (2011) 
     44   !! $Id$ 
     45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     46   !!---------------------------------------------------------------------- 
     47CONTAINS  
     48 
     49   INTEGER FUNCTION agrif_oce_alloc() 
     50      !!---------------------------------------------------------------------- 
     51      !!                ***  FUNCTION agrif_oce_alloc  *** 
     52      !!---------------------------------------------------------------------- 
     53      ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      & 
     54         &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc )  
     55   END FUNCTION agrif_oce_alloc 
    3256 
    3357#endif 
    34    !!---------------------------------------------------------------------- 
    35    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    36    !! $Id$ 
    37    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3858   !!====================================================================== 
    3959END MODULE agrif_oce 

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

    r2528 r2715  
    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 

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

    r2528 r2715  
    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       

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

    r2528 r2715  
    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 

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

    r2528 r2715  
    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 

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

    r2528 r2715  
    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 

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

    r2528 r2715  
    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 

  • 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.