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 3294 for trunk/NEMOGCM/NEMO/NST_SRC – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

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

Legend:

Unmodified
Added
Removed

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

    r2715 r3294  
    3535   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ??? 
    3636    
    37    INTEGER :: tn_id, sn_id, tb_id, sb_id, ta_id, sa_id 
     37   INTEGER :: tsn_id,tsb_id,tsa_id 
    3838   INTEGER :: un_id, vn_id, ua_id, va_id 
    3939   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 

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

    r2715 r3294  
    2727   USE agrif_opa_sponge 
    2828   USE lib_mpp 
     29   USE wrk_nemo   
    2930 
    3031   IMPLICIT NONE 
    … …  
    4748      !!                  ***  ROUTINE Agrif_Tra  *** 
    4849      !!---------------------------------------------------------------------- 
    49       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    50       USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
    5150      !! 
    52       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     51      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    5352      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3 
    5453      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7 
    55       REAL(wp), POINTER, DIMENSION(:,:,:) :: zta, zsa 
     54      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa 
    5655      !!---------------------------------------------------------------------- 
    5756      ! 
    5857      IF( Agrif_Root() )   RETURN 
    5958 
    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 
     59      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa )  
    6560 
    6661      Agrif_SpecialValue    = 0.e0 
    6762      Agrif_UseSpecialValue = .TRUE. 
    68       zta(:,:,:) = 0.e0 
    69       zsa(:,:,:) = 0.e0 
    70  
    71       CALL Agrif_Bc_variable( zta, tn_id, procname = interptn ) 
    72       CALL Agrif_Bc_variable( zsa, sn_id, procname = interpsn ) 
     63      ztsa(:,:,:,:) = 0.e0 
     64 
     65      CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn ) 
    7366      Agrif_UseSpecialValue = .FALSE. 
    7467 
    … …  
    8780      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    8881 
    89          ta(nlci,:,:) = alpha1 * zta(nlci,:,:) + alpha2 * zta(nlci-1,:,:) 
    90          sa(nlci,:,:) = alpha1 * zsa(nlci,:,:) + alpha2 * zsa(nlci-1,:,:) 
    91  
    92          DO jk = 1, jpkm1 
    93             DO jj = 1, jpj 
    94                IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    95                   ta(nlci-1,jj,jk) = ta(nlci,jj,jk) * tmask(nlci-1,jj,jk) 
    96                   sa(nlci-1,jj,jk) = sa(nlci,jj,jk) * tmask(nlci-1,jj,jk) 
    97                ELSE 
    98                   ta(nlci-1,jj,jk)=(alpha4*ta(nlci,jj,jk)+alpha3*ta(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 
    99                   sa(nlci-1,jj,jk)=(alpha4*sa(nlci,jj,jk)+alpha3*sa(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 
    100                   IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
    101                      ta(nlci-1,jj,jk)=( alpha6*ta(nlci-2,jj,jk)+alpha5*ta(nlci,jj,jk)  & 
    102                         &             + alpha7*ta(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 
    103                      sa(nlci-1,jj,jk)=( alpha6*sa(nlci-2,jj,jk)+alpha5*sa(nlci,jj,jk)  & 
    104                         &             + alpha7*sa(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 
     82         DO jn = 1, jpts 
     83            tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn) 
     84            DO jk = 1, jpkm1 
     85               DO jj = 1, jpj 
     86                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     87                     tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     88                  ELSE 
     89                     tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     90                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     91                        tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  & 
     92                           &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     93                     ENDIF 
    10594                  ENDIF 
    106                ENDIF 
    107             END DO 
    108          END DO 
     95               END DO 
     96            END DO 
     97         ENDDO 
    10998      ENDIF 
    11099 
    111100      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    112101 
    113          ta(:,nlcj,:) = alpha1 * zta(:,nlcj,:) + alpha2 * zta(:,nlcj-1,:) 
    114          sa(:,nlcj,:) = alpha1 * zsa(:,nlcj,:) + alpha2 * zsa(:,nlcj-1,:) 
    115  
    116          DO jk = 1, jpkm1 
    117             DO ji = 1, jpi 
    118                IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
    119                   ta(ji,nlcj-1,jk) = ta(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 
    120                   sa(ji,nlcj-1,jk) = sa(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 
    121                ELSE 
    122                   ta(ji,nlcj-1,jk)=(alpha4*ta(ji,nlcj,jk)+alpha3*ta(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk)         
    123                   sa(ji,nlcj-1,jk)=(alpha4*sa(ji,nlcj,jk)+alpha3*sa(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk) 
    124                   IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
    125                      ta(ji,nlcj-1,jk)=( alpha6*ta(ji,nlcj-2,jk)+alpha5*ta(ji,nlcj,jk)  & 
    126                         &             + alpha7*ta(ji,nlcj-3,jk) ) * tmask(ji,nlcj-1,jk) 
    127                      sa(ji,nlcj-1,jk)=( alpha6*sa(ji,nlcj-2,jk)+alpha5*sa(ji,nlcj,jk)  & 
    128                         &             + alpha7*sa(ji,nlcj-3,jk))*tmask(ji,nlcj-1,jk) 
     102         DO jn = 1, jpts 
     103            tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn) 
     104            DO jk = 1, jpkm1 
     105               DO ji = 1, jpi 
     106                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     107                     tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     108                  ELSE 
     109                     tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     110                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     111                        tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  & 
     112                           &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     113                     ENDIF 
    129114                  ENDIF 
    130                ENDIF 
    131             END DO 
    132          END DO 
     115               END DO 
     116            END DO 
     117         ENDDO  
    133118      ENDIF 
    134119 
    135120      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    136          ta(1,:,:) = alpha1 * zta(1,:,:) + alpha2 * zta(2,:,:) 
    137          sa(1,:,:) = alpha1 * zsa(1,:,:) + alpha2 * zsa(2,:,:)       
    138          DO jk = 1, jpkm1 
    139             DO jj = 1, jpj 
    140                IF( umask(2,jj,jk) == 0.e0 ) THEN 
    141                   ta(2,jj,jk) = ta(1,jj,jk) * tmask(2,jj,jk) 
    142                   sa(2,jj,jk) = sa(1,jj,jk) * tmask(2,jj,jk) 
    143                ELSE 
    144                   ta(2,jj,jk)=(alpha4*ta(1,jj,jk)+alpha3*ta(3,jj,jk))*tmask(2,jj,jk)         
    145                   sa(2,jj,jk)=(alpha4*sa(1,jj,jk)+alpha3*sa(3,jj,jk))*tmask(2,jj,jk) 
    146                   IF( un(2,jj,jk) < 0.e0 ) THEN 
    147                      ta(2,jj,jk)=(alpha6*ta(3,jj,jk)+alpha5*ta(1,jj,jk)+alpha7*ta(4,jj,jk))*tmask(2,jj,jk) 
    148                      sa(2,jj,jk)=(alpha6*sa(3,jj,jk)+alpha5*sa(1,jj,jk)+alpha7*sa(4,jj,jk))*tmask(2,jj,jk) 
     121         DO jn = 1, jpts 
     122            tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn) 
     123            DO jk = 1, jpkm1 
     124               DO jj = 1, jpj 
     125                  IF( umask(2,jj,jk) == 0.e0 ) THEN 
     126                     tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
     127                  ELSE 
     128                     tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
     129                     IF( un(2,jj,jk) < 0.e0 ) THEN 
     130                        tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
     131                     ENDIF 
    149132                  ENDIF 
    150                ENDIF 
     133               END DO 
    151134            END DO 
    152135         END DO 
    … …  
    154137 
    155138      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    156          ta(:,1,:) = alpha1 * zta(:,1,:) + alpha2 * zta(:,2,:) 
    157          sa(:,1,:) = alpha1 * zsa(:,1,:) + alpha2 * zsa(:,2,:) 
    158          DO jk=1,jpk       
    159             DO ji=1,jpi 
    160                IF( vmask(ji,2,jk) == 0.e0 ) THEN 
    161                   ta(ji,2,jk)=ta(ji,1,jk) * tmask(ji,2,jk) 
    162                   sa(ji,2,jk)=sa(ji,1,jk) * tmask(ji,2,jk) 
    163                ELSE 
    164                   ta(ji,2,jk)=(alpha4*ta(ji,1,jk)+alpha3*ta(ji,3,jk))*tmask(ji,2,jk) 
    165                   sa(ji,2,jk)=(alpha4*sa(ji,1,jk)+alpha3*sa(ji,3,jk))*tmask(ji,2,jk)  
    166                   IF( vn(ji,2,jk) < 0.e0 ) THEN 
    167                      ta(ji,2,jk)=(alpha6*ta(ji,3,jk)+alpha5*ta(ji,1,jk)+alpha7*ta(ji,4,jk))*tmask(ji,2,jk) 
    168                      sa(ji,2,jk)=(alpha6*sa(ji,3,jk)+alpha5*sa(ji,1,jk)+alpha7*sa(ji,4,jk))*tmask(ji,2,jk) 
     139         DO jn = 1, jpts 
     140            tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn) 
     141            DO jk=1,jpk       
     142               DO ji=1,jpi 
     143                  IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     144                     tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
     145                  ELSE 
     146                     tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
     147                     IF( vn(ji,2,jk) < 0.e0 ) THEN 
     148                        tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
     149                     ENDIF 
    169150                  ENDIF 
    170                ENDIF 
    171             END DO 
    172          END DO 
     151               END DO 
     152            END DO 
     153         ENDDO 
    173154      ENDIF 
    174155      ! 
    175       IF( wrk_not_released(3, 1,2) ) THEN 
    176          CALL ctl_stop('agrif_tra: failed to release workspace arrays.') 
    177       ENDIF 
     156      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsa )  
    178157      ! 
    179158   END SUBROUTINE Agrif_tra 
    … …  
    184163      !!                  ***  ROUTINE Agrif_DYN  *** 
    185164      !!----------------------------------------------------------------------   
    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 
    190165      !!  
    191166      INTEGER, INTENT(in) ::   kt 
    … …  
    201176      IF( Agrif_Root() )   RETURN 
    202177 
    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 
     178      CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d ) 
     179      CALL wrk_alloc( jpi, jpj, jpk, zua, zva ) 
    210180 
    211181      zrhox = Agrif_Rhox() 
    … …  
    520490      ENDIF 
    521491      ! 
    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 
     492      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d ) 
     493      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva ) 
    525494      ! 
    526495   END SUBROUTINE Agrif_dyn 

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

    r2715 r3294  
    88   USE in_out_manager 
    99   USE agrif_oce 
     10   USE wrk_nemo   
    1011 
    1112   IMPLICIT NONE 
    1213   PRIVATE 
    1314 
    14    PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptn, interpsn, interpun, interpvn 
     15   PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
    1516 
    1617   !!---------------------------------------------------------------------- 
    … …  
    2728      !!--------------------------------------------- 
    2829#include "domzgr_substitute.h90" 
    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 
    3530      !! 
    36       INTEGER :: ji,jj,jk 
     31      INTEGER :: ji,jj,jk,jn 
    3732      INTEGER :: spongearea 
    3833      REAL(wp) :: timecoeff 
    39       REAL(wp) :: zta, zsa, zabe1, zabe2, zbtr 
    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 
     34      REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
     35      REAL(wp), POINTER, DIMENSION(:,:    ) :: localviscsponge 
     36      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv 
     37      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
     38      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff 
    4439 
    4540#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 
     41      CALL wrk_alloc( jpi, jpj, localviscsponge, ztu, ztv ) 
     42      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    5143 
    5244      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    5547      Agrif_UseSpecialValue = .TRUE. 
    5648      ztab = 0.e0 
    57       CALL Agrif_Bc_Variable(ztab, ta_id,calledweight=timecoeff,procname=interptn) 
     49      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn) 
    5850      Agrif_UseSpecialValue = .FALSE. 
    5951 
    60       tbdiff(:,:,:) = tb(:,:,:) - ztab(:,:,:) 
    61  
    62       ztab = 0.e0 
    63       Agrif_SpecialValue=0. 
    64       Agrif_UseSpecialValue = .TRUE. 
    65       CALL Agrif_Bc_Variable(ztab, sa_id,calledweight=timecoeff,procname=interpsn) 
    66       Agrif_UseSpecialValue = .FALSE. 
    67  
    68       sbdiff(:,:,:) = sb(:,:,:) - ztab(:,:,:) 
     52      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 
    6953 
    7054      spongearea = 2 + 2 * Agrif_irhox() 
    … …  
    137121      ENDIF 
    138122 
    139       DO jk = 1, jpkm1 
    140          DO jj = 1, jpjm1 
    141             DO ji = 1, jpim1 
    142                zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
    143                zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
    144                ztu(ji,jj,jk) = zabe1 * ( tbdiff(ji+1,jj  ,jk) - tbdiff(ji,jj,jk) ) 
    145                zsu(ji,jj,jk) = zabe1 * ( sbdiff(ji+1,jj  ,jk) - sbdiff(ji,jj,jk) ) 
    146                ztv(ji,jj,jk) = zabe2 * ( tbdiff(ji  ,jj+1,jk) - tbdiff(ji,jj,jk) ) 
    147                zsv(ji,jj,jk) = zabe2 * ( sbdiff(ji  ,jj+1,jk) - sbdiff(ji,jj,jk) ) 
     123      DO jn = 1, jpts 
     124         DO jk = 1, jpkm1 
     125            ! 
     126            DO jj = 1, jpjm1 
     127               DO ji = 1, jpim1 
     128                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
     129                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
     130                  ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     131                  ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     132               ENDDO 
    148133            ENDDO 
    149          ENDDO 
    150  
    151          DO jj = 2,jpjm1 
    152             DO ji = 2,jpim1 
    153                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    154                ! horizontal diffusive trends 
    155                zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
    156                   &          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    157                zsa = zbtr * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)   & 
    158                   &          + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) 
    159                ! add it to the general tracer trends 
    160                ta(ji,jj,jk) = (ta(ji,jj,jk) + zta) 
    161                sa(ji,jj,jk) = (sa(ji,jj,jk) + zsa) 
     134 
     135            DO jj = 2, jpjm1 
     136               DO ji = 2, jpim1 
     137                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
     138                  ! horizontal diffusive trends 
     139                  ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   & 
     140                  &              + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
     141                  ! add it to the general tracer trends 
     142                  tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
     143               END DO 
    162144            END DO 
    163          END DO 
    164  
     145            ! 
     146         ENDDO 
    165147      ENDDO 
    166148 
     149      CALL wrk_dealloc( jpi, jpj, localviscsponge, ztu, ztv ) 
     150      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    167151#endif 
    168152 
    … …  
    174158      !!--------------------------------------------- 
    175159#include "domzgr_substitute.h90" 
    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 
    181160      !! 
    182161      INTEGER :: ji,jj,jk 
    … …  
    190169 
    191170#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 
     171      CALL wrk_alloc( jpi, jpj, localviscsponge ) 
     172      CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    196173 
    197174      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    340317      END DO                                           !   End of slab 
    341318      !                                                ! =============== 
     319      CALL wrk_dealloc( jpi, jpj, localviscsponge ) 
     320      CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    342321 
    343322#endif 
    … …  
    345324   END SUBROUTINE Agrif_Sponge_dyn 
    346325 
    347    SUBROUTINE interptn(tabres,i1,i2,j1,j2,k1,k2) 
    348       !!--------------------------------------------- 
    349       !!   *** ROUTINE interptn *** 
     326   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
     327      !!--------------------------------------------- 
     328      !!   *** ROUTINE interptsn *** 
    350329      !!--------------------------------------------- 
    351330#  include "domzgr_substitute.h90"        
    352331       
    353       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    354       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    355  
    356       tabres(i1:i2,j1:j2,k1:k2) = tn(i1:i2,j1:j2,k1:k2) 
    357  
    358    END SUBROUTINE interptn 
    359  
    360    SUBROUTINE interpsn(tabres,i1,i2,j1,j2,k1,k2) 
    361       !!--------------------------------------------- 
    362       !!   *** ROUTINE interpsn *** 
    363       !!--------------------------------------------- 
    364 #  include "domzgr_substitute.h90"        
    365        
    366       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    367       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    368  
    369       tabres(i1:i2,j1:j2,k1:k2) = sn(i1:i2,j1:j2,k1:k2) 
    370  
    371    END SUBROUTINE interpsn 
     332      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     333      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     334 
     335      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     336 
     337   END SUBROUTINE interptsn 
    372338 
    373339   SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2) 

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

    r2802 r3294  
    99   USE in_out_manager  ! I/O manager 
    1010   USE lib_mpp 
    11    USE traswp 
    12     
     11   USE wrk_nemo   
     12 
    1313   IMPLICIT NONE 
    1414   PRIVATE 
    … …  
    3030      !!   *** ROUTINE Agrif_Update_Tra *** 
    3131      !!--------------------------------------------- 
    32       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    33       USE wrk_nemo, ONLY: wrk_3d_1 
    3432      !! 
    3533      INTEGER, INTENT(in) :: kt 
    36       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
     34      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    3735 
    3836        
    3937      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    4038#if defined TWO_WAY 
    41       ztab => wrk_3d_1 
    42       IF( wrk_in_use(3, 1) ) THEN 
    43          CALL ctl_stop('agrif_update_tra: ERROR: requested workspace arrays unavailable') 
    44          RETURN 
    45       END IF 
     39      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab ) 
    4640 
    4741      Agrif_UseSpecialValueInUpdate = .TRUE. 
    … …  
    4943 
    5044      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
    51          CALL Agrif_Update_Variable(ztab,tn_id, procname=updateT) 
    52          CALL Agrif_Update_Variable(ztab,sn_id, procname=updateS) 
    53       ELSE 
    54          CALL Agrif_Update_Variable(ztab,tn_id,locupdate=(/0,2/), procname=updateT) 
    55          CALL Agrif_Update_Variable(ztab,sn_id,locupdate=(/0,2/), procname=updateS) 
     45         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 
     46      ELSE 
     47         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 
    5648      ENDIF 
    5749 
    5850      Agrif_UseSpecialValueInUpdate = .FALSE. 
    5951 
    60       CALL Agrif_ChildGrid_To_ParentGrid() 
    61       CALL tra_swap 
    62       CALL Agrif_ParentGrid_To_ChildGrid() 
    63  
    64       IF( wrk_not_released(3, 1) ) THEN 
    65          CALL ctl_stop('Agrif_Update_Tra: ERROR: failed to release workspace arrays') 
    66       END IF 
     52      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab ) 
    6753#endif 
    6854 
    … …  
    7359      !!   *** ROUTINE Agrif_Update_Dyn *** 
    7460      !!--------------------------------------------- 
    75       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    76       USE wrk_nemo, ONLY: wrk_2d_1 
    77       USE wrk_nemo, ONLY: wrk_3d_1 
    7861      !! 
    7962      INTEGER, INTENT(in) :: kt 
    … …  
    8467      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return 
    8568#if defined TWO_WAY 
    86       ztab => wrk_3d_1 ; ztab2d => wrk_2d_1 
    87       IF( ( wrk_in_use(2, 1)) .OR.  wrk_in_use(3, 1) )THEN 
    88          CALL ctl_stop('agrif_update_dyn: ERROR: requested workspace arrays unavailable') 
    89          RETURN 
    90       END IF 
     69      CALL wrk_alloc( jpi, jpj,      ztab2d ) 
     70      CALL wrk_alloc( jpi, jpj, jpk, ztab   ) 
    9171 
    9272      IF (mod(nbcline,nbclineupdate) == 0) THEN 
    … …  
    10888      Agrif_UseSpecialValueInUpdate = .FALSE. 
    10989 
    110       IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )THEN 
    111          CALL ctl_stop('agrif_update_dyn: ERROR: failed to release workspace arrays') 
    112       END IF 
     90      CALL wrk_dealloc( jpi, jpj,      ztab2d ) 
     91      CALL wrk_dealloc( jpi, jpj, jpk, ztab   ) 
    11392 
    11493!Done in step 
    … …  
    129108   END SUBROUTINE recompute_diags 
    130109 
    131    SUBROUTINE updateT( tabres, i1, i2, j1, j2, k1, k2, before ) 
     110   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    132111      !!--------------------------------------------- 
    133112      !!           *** ROUTINE updateT *** 
    … …  
    135114#  include "domzgr_substitute.h90" 
    136115 
    137       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    138       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     116      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     117      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    139118      LOGICAL, iNTENT(in) :: before 
    140119 
    141       INTEGER :: ji,jj,jk 
    142  
    143       IF (before) THEN 
    144          DO jk=k1,k2 
    145             DO jj=j1,j2 
    146                DO ji=i1,i2 
    147                   tabres(ji,jj,jk) = tn(ji,jj,jk) 
    148                END DO 
    149             END DO 
    150          END DO 
    151       ELSE 
    152          DO jk=k1,k2 
    153             DO jj=j1,j2 
    154                DO ji=i1,i2 
    155                   IF( tabres(ji,jj,jk) .NE. 0. ) THEN 
    156                      tn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk) 
    157                   ENDIF 
    158                END DO 
    159             END DO 
    160          END DO 
    161       ENDIF 
    162  
    163    END SUBROUTINE updateT 
    164  
    165    SUBROUTINE updateS( tabres, i1, i2, j1, j2, k1, k2, before ) 
    166       !!--------------------------------------------- 
    167       !!           *** ROUTINE updateS *** 
    168       !!--------------------------------------------- 
    169 #  include "domzgr_substitute.h90" 
    170  
    171       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    172       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    173       LOGICAL, iNTENT(in) :: before 
    174  
    175       INTEGER :: ji,jj,jk 
    176  
    177       IF (before) THEN 
    178          DO jk=k1,k2 
    179             DO jj=j1,j2 
    180                DO ji=i1,i2 
    181                   tabres(ji,jj,jk) = sn(ji,jj,jk) 
    182                END DO 
    183             END DO 
    184          END DO 
    185       ELSE 
    186          DO jk=k1,k2 
    187             DO jj=j1,j2 
    188                DO ji=i1,i2 
    189                   IF (tabres(ji,jj,jk).NE.0.) THEN 
    190                      sn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk) 
    191                   ENDIF 
    192                END DO 
    193             END DO 
    194          END DO 
    195       ENDIF 
    196  
    197    END SUBROUTINE updateS 
     120      INTEGER :: ji,jj,jk,jn 
     121 
     122      IF (before) THEN 
     123         DO jn = n1,n2 
     124            DO jk=k1,k2 
     125               DO jj=j1,j2 
     126                  DO ji=i1,i2 
     127                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 
     128                  END DO 
     129               END DO 
     130            END DO 
     131         END DO 
     132      ELSE 
     133         DO jn = n1,n2 
     134            DO jk=k1,k2 
     135               DO jj=j1,j2 
     136                  DO ji=i1,i2 
     137                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN  
     138                         tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     139                     END IF 
     140                  END DO 
     141               END DO 
     142            END DO 
     143         END DO 
     144      ENDIF 
     145 
     146   END SUBROUTINE updateTS 
    198147 
    199148   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 

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

    r2715 r3294  
    99   USE trc 
    1010   USE lib_mpp 
     11   USE wrk_nemo   
    1112 
    1213   IMPLICIT NONE 
    … …  
    2930      !!   *** ROUTINE Agrif_trc *** 
    3031      !!--------------------------------------------- 
    31       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    32       USE wrk_nemo, ONLY: wrk_4d_1 
    3332       
    3433      INTEGER :: ji,jj,jk,jn 
    … …  
    4039      IF (Agrif_Root()) RETURN 
    4140 
    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) 
     41      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 
    4742 
    4843      Agrif_SpecialValue=0. 
    … …  
    141136      ENDIF 
    142137 
    143       IF( wrk_not_released(4, 1) ) THEN 
    144          CALL ctl_stop('Agrif_trc : failed to release workspace arrays.') 
    145          RETURN 
    146       ENDIF 
     138      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 
    147139 
    148140   END SUBROUTINE Agrif_trc 

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

    r2715 r3294  
    1010   USE trc 
    1111   USE lib_mpp 
     12   USE wrk_nemo   
    1213 
    1314   IMPLICIT NONE 
    … …  
    2930      !!--------------------------------------------- 
    3031#include "domzgr_substitute.h90" 
    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 
    3432      !!  
    3533      INTEGER :: ji,jj,jk,jl 
    … …  
    4139 
    4240#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) 
     41      CALL wrk_alloc( jpi, jpj, localviscsponge ) 
     42      CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab ) 
    5243 
    5344      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    155146      ENDDO 
    156147  
    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 
     148      CALL wrk_dealloc( jpi, jpj, localviscsponge ) 
     149      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab ) 
    161150 
    162151#endif 

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

    r2715 r3294  
    99   USE agrif_oce 
    1010   USE trc 
     11   USE wrk_nemo   
    1112 
    1213   IMPLICIT NONE 
    … …  
    2930      !!   *** ROUTINE Agrif_Update_Trc *** 
    3031      !!--------------------------------------------- 
    31       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    32       USE wrk_nemo, ONLY: wrk_4d_1 
    3332      !! 
    3433      INTEGER, INTENT(in) :: kt 
    … …  
    3938 
    4039#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) 
     40      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztra ) 
    4641 
    4742      Agrif_UseSpecialValueInUpdate = .TRUE. 
    … …  
    5752      nbcline_trc = nbcline_trc + 1 
    5853 
    59       IF( wrk_not_released(4, 1) ) THEN 
    60          CALL ctl_stop('Agrif_Update_trc : failed to release workspace arrays.') 
    61          RETURN 
    62       ENDIF 
     54      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztra ) 
    6355#endif 
    6456 

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

    r2727 r3294  
    5454      USE dom_oce 
    5555      USE nemogcm 
    56 #if defined key_tradmp   ||   defined key_esopa 
    5756      USE tradmp 
    58 #endif 
    59 #if defined key_obc   ||   defined key_esopa 
    6057      USE obc_par 
    61 #endif 
     58      USE bdy_par 
     59 
    6260      IMPLICIT NONE 
    6361      !!---------------------------------------------------------------------- 
    … …  
    7169 
    7270      ! Specific fine grid Initializations 
    73 #if defined key_tradmp || defined key_esopa 
    7471      ! no tracer damping on fine grids 
    75       lk_tradmp = .FALSE. 
    76 #endif 
    77 #if defined key_obc || defined key_esopa 
     72      ln_tradmp = .FALSE. 
    7873      ! no open boundary on fine grids 
    7974      lk_obc = .FALSE. 
    80 #endif 
     75      lk_bdy = .FALSE. 
    8176 
    8277      CALL nemo_init  ! Initializations of each fine grid 
    … …  
    110105      IMPLICIT NONE 
    111106      ! 
    112       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp 
     107      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
     108      REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
    113109      LOGICAL :: check_namelist 
    114110      !!---------------------------------------------------------------------- 
    115111 
    116       ALLOCATE( tabtemp(jpi,jpj,jpk) ) 
    117        
    118        
     112      ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
     113      ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
     114 
     115 
    119116      ! 1. Declaration of the type of variable which have to be interpolated 
    120117      !--------------------------------------------------------------------- 
    … …  
    125122      Agrif_SpecialValue=0. 
    126123      Agrif_UseSpecialValue = .TRUE. 
    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) 
     124      Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
     125      Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
     126 
     127      Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
     128      Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
     129      Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
     130      Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
    138131      Agrif_UseSpecialValue = .FALSE. 
    139132 
    … …  
    192185      nbcline = 0 
    193186      ! 
    194       DEALLOCATE(tabtemp) 
     187      DEALLOCATE(tabtstemp) 
     188      DEALLOCATE(tabuvtemp) 
    195189      ! 
    196190   END SUBROUTINE Agrif_InitValues_cont 
    … …  
    204198      !!---------------------------------------------------------------------- 
    205199      USE agrif_util 
     200      USE par_oce       !   ONLY : jpts 
    206201      USE oce 
    207202      IMPLICIT NONE 
    … …  
    210205      ! 1. Declaration of the type of variable which have to be interpolated 
    211206      !--------------------------------------------------------------------- 
    212       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tn_id) 
    213       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sn_id) 
    214       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tb_id) 
    215       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sb_id) 
    216       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ta_id) 
    217       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sa_id) 
    218           
     207      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     208      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
     209      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
     210 
    219211      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
    220212      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
    … …  
    230222      ! 2. Type of interpolation 
    231223      !------------------------- 
    232       CALL Agrif_Set_bcinterp(tn_id,interp=AGRIF_linear) 
    233       CALL Agrif_Set_bcinterp(sn_id,interp=AGRIF_linear) 
    234       CALL Agrif_Set_bcinterp(ta_id,interp=AGRIF_linear) 
    235       CALL Agrif_Set_bcinterp(sa_id,interp=AGRIF_linear) 
     224      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
     225      CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
    236226    
    237227      Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    … …  
    252242      Call Agrif_Set_bc(e2v_id,(/0,0/)) 
    253243 
    254       Call Agrif_Set_bc(tn_id,(/0,1/)) 
    255       Call Agrif_Set_bc(sn_id,(/0,1/)) 
    256  
    257       Call Agrif_Set_bc(ta_id,(/-3*Agrif_irhox(),0/)) 
    258       Call Agrif_Set_bc(sa_id,(/-3*Agrif_irhox(),0/)) 
     244      Call Agrif_Set_bc(tsn_id,(/0,1/)) 
     245      Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
    259246 
    260247      Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
    … …  
    263250      ! 5. Update type 
    264251      !---------------  
    265       Call Agrif_Set_Updatetype(tn_id, update = AGRIF_Update_Average) 
    266       Call Agrif_Set_Updatetype(sn_id, update = AGRIF_Update_Average) 
    267  
    268       Call Agrif_Set_Updatetype(tb_id, update = AGRIF_Update_Average) 
    269       Call Agrif_Set_Updatetype(sb_id, update = AGRIF_Update_Average) 
     252      Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     253      Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
    270254 
    271255      Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    … …  
    395379      ! 1. Declaration of the type of variable which have to be interpolated 
    396380      !--------------------------------------------------------------------- 
    397       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
    398       &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    399       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
    400       &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
    401       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0,jptra/),(/'x','y','N','N'/),  & 
    402       &                           (/1,1,1,1/),(/jpi,jpj,jpk/),tra_id) 
    403              
     381      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     382      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
     383      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
    404384#  if defined key_offline 
    405385      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
Note: See TracChangeset for help on using the changeset viewer.