New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3653 for branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO – NEMO

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

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

Location:
branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO
Files:
20 deleted
69 edited
10 copied

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    r3294 r3653  
    3030   USE in_out_manager ! I/O manager 
    3131   USE prtctl         ! Print control 
     32#if defined key_agrif 
     33   USE agrif_lim2_interp ! nesting 
     34#endif 
    3235 
    3336   IMPLICIT NONE 
    … …  
    129132!i    zviszeta(:,jpj+1) = 0._wp    ;    zviseta(:,jpj+1) = 0._wp 
    130133 
     134#if defined key_agrif 
     135      ! load the boundary value of velocity in special array zuive and zvice 
     136      CALL agrif_rhg_lim2_load 
     137#endif 
    131138 
    132139      ! Ice mass, ice strength, and wind stress at the center            | 
    … …  
    533540            CALL lbc_lnk( zv_n(:,1:jpj), 'I', -1. ) 
    534541 
     542#if defined key_agrif 
     543            ! copy the boundary value from u_ice_nst and v_ice_nst to u_ice and v_ice 
     544            ! before next interations 
     545            CALL agrif_rhg_lim2(zu_n,zv_n) 
     546#endif 
     547 
    535548            ! Test of Convergence 
    536549            DO jj = k_j1+1 , k_jpj-1 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

    r3294 r3653  
    2828   USE lib_mpp         ! MPP library 
    2929   USE wrk_nemo        ! work arrays 
     30# if defined key_agrif 
     31   USE agrif_lim2_interp ! nesting 
     32# endif 
    3033 
    3134   IMPLICIT NONE 
    … …  
    8083 
    8184      IF( kt == nit000  )   CALL lim_trp_init_2      ! Initialization (first time-step only) 
     85 
     86# if defined key_agrif 
     87      CALL agrif_trp_lim2_load      ! First interpolation 
     88# endif 
    8289 
    8390      zsm(:,:) = area(:,:) 
    … …  
    269276      ENDIF 
    270277      ! 
     278# if defined key_agrif 
     279      CALL agrif_trp_lim2      ! Fill boundaries of the fine grid 
     280# endif 
     281      !  
    271282      CALL wrk_dealloc( jpi, jpj, zui_u , zvi_v , zsm, zs0ice, zs0sn , zs0a, zs0c0 , zs0c1 , zs0c2 , zs0st ) 
    272283      ! 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r3294 r3653  
    88   !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy  
    99   !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas 
    10    !!            4.0  !  2011-01  (A Porter)  dynamical allocation  
     10   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation  
     11   !!            3.5  !  2012-08  (R. Benshila)  AGRIF  
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp ) 
    … …  
    3435   USE ice_2            ! LIM2: ice variables 
    3536   USE dom_ice_2        ! LIM2: ice domain 
     37#endif 
     38#if defined key_agrif && defined key_lim2 
     39   USE agrif_lim2_interp 
    3640#endif 
    3741 
    … …  
    162166     at_i(:,:) = 1. - frld(:,:) 
    163167#endif 
     168#if defined key_agrif && defined key_lim2  
     169    CALL agrif_rhg_lim2_load      ! First interpolation of coarse values 
     170#endif 
    164171      ! 
    165172      !------------------------------------------------------------------------------! 
    … …  
    488495 
    489496            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
     497#if defined key_agrif 
     498            CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     499#endif 
    490500 
    491501!CDIR NOVERRCHK 
    … …  
    513523 
    514524            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
     525#if defined key_agrif 
     526            CALL agrif_rhg_lim2( jter, nevp, 'V' ) 
     527#endif 
    515528 
    516529         ELSE  
    … …  
    539552 
    540553            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
     554#if defined key_agrif 
     555            CALL agrif_rhg_lim2( jter, nevp , 'V' ) 
     556#endif 
    541557 
    542558!CDIR NOVERRCHK 
    … …  
    567583 
    568584            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
     585#if defined key_agrif 
     586            CALL agrif_rhg_lim2( jter, nevp, 'U' ) 
     587#endif 
    569588 
    570589         ENDIF 
    … …  
    607626      CALL lbc_lnk( u_ice(:,:), 'U', -1. )  
    608627      CALL lbc_lnk( v_ice(:,:), 'V', -1. )  
     628#if defined key_agrif 
     629      CALL agrif_rhg_lim2( nevp , nevp, 'U' ) 
     630      CALL agrif_rhg_lim2( nevp , nevp, 'V' ) 
     631#endif 
    609632 
    610633      DO jj = k_j1+1, k_jpj-1  

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif2model.F90

    r2528 r3653  
    55   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    66   !!---------------------------------------------------------------------- 
     7   SUBROUTINE Agrif2Model 
     8      !!--------------------------------------------- 
     9      !!   *** ROUTINE Agrif2Model *** 
     10      !!---------------------------------------------  
     11   END SUBROUTINE Agrif2model 
    712 
    813   SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr) 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r3294 r3653  
    2525 
    2626   !                                              !!! OLD namelist names 
     27   INTEGER , PUBLIC ::   nbcline = 0               !: update counter 
    2728   INTEGER , PUBLIC ::   nbclineupdate             !: update frequency  
    2829   REAL(wp), PUBLIC ::   visc_tra                  !: sponge coeff. for tracers 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r3294 r3653  
    1 #define SPONGE 
     1#define SPONGE && define SPONGE_TOP 
    22 
    33Module agrif_opa_sponge 
    … …  
    1313   PRIVATE 
    1414 
    15    PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
    16  
     15   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
     16 
     17  !! * Substitutions 
     18#  include "domzgr_substitute.h90" 
    1719   !!---------------------------------------------------------------------- 
    1820   !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    … …  
    2729      !!   *** ROUTINE Agrif_Sponge_Tra *** 
    2830      !!--------------------------------------------- 
    29 #include "domzgr_substitute.h90" 
    3031      !! 
    3132      INTEGER :: ji,jj,jk,jn 
    32       INTEGER :: spongearea 
    3333      REAL(wp) :: timecoeff 
    3434      REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
    35       REAL(wp), POINTER, DIMENSION(:,:    ) :: localviscsponge 
    3635      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv 
    3736      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    … …  
    3938 
    4039#if defined SPONGE 
    41       CALL wrk_alloc( jpi, jpj, localviscsponge, ztu, ztv ) 
     40      CALL wrk_alloc( jpi, jpj, ztu, ztv ) 
    4241      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    4342 
    … …  
    5251      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 
    5352 
    54       spongearea = 2 + 2 * Agrif_irhox() 
    55  
    56       localviscsponge = 0. 
    57        
    58       IF (.NOT. spongedoneT) THEN 
    59          spe1ur(:,:) = 0. 
    60          spe2vr(:,:) = 0. 
    61  
    62       IF ((nbondi == -1).OR.(nbondi == 2)) THEN 
    63          DO ji = 2, spongearea 
    64             localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2) 
    65          ENDDO 
    66      
    67     spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) & 
    68           * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:) 
    69  
    70          spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 
    71              localviscsponge(2:spongearea,2:jpj)) & 
    72            * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1) 
    73       ENDIF 
    74  
    75       IF ((nbondi == 1).OR.(nbondi == 2)) THEN 
    76          DO ji = nlci-spongearea + 1,nlci-1 
    77             localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2) 
    78          ENDDO 
    79      
    80     spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 
    81            localviscsponge(nlci-spongearea + 2:nlci-1,:)) & 
    82           * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:) 
    83  
    84          spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 
    85               + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) & 
    86            * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1) 
    87       ENDIF 
    88  
    89  
    90       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    91          DO jj = 2, spongearea 
    92             localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2) 
    93          ENDDO 
    94      
    95     spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 
    96            localviscsponge(2:jpi,2:spongearea)) & 
    97           * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea) 
    98  
    99          spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 
    100              localviscsponge(:,3:spongearea)) & 
    101            * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1) 
    102       ENDIF 
    103  
    104       IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    105          DO jj = nlcj-spongearea + 1,nlcj-1 
    106             localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2) 
    107          ENDDO 
    108      
    109     spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 
    110             localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) & 
    111           * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1) 
    112  
    113          spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 
    114             localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) & 
    115            * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2) 
    116       ENDIF 
    117        
    118          spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:)) 
    119  
    120          spongedoneT = .TRUE. 
    121       ENDIF 
     53      CALL Agrif_Sponge 
    12254 
    12355      DO jn = 1, jpts 
    … …  
    14779      ENDDO 
    14880 
    149       CALL wrk_dealloc( jpi, jpj, localviscsponge, ztu, ztv ) 
     81      CALL wrk_dealloc( jpi, jpj, ztu, ztv ) 
    15082      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    15183#endif 
    … …  
    15789      !!   *** ROUTINE Agrif_Sponge_dyn *** 
    15890      !!--------------------------------------------- 
    159 #include "domzgr_substitute.h90" 
    16091      !! 
    16192      INTEGER :: ji,jj,jk 
    162       INTEGER :: spongearea 
    16393      REAL(wp) :: timecoeff 
    16494      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
    165       REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
    16695      REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff 
    16796      REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff 
    … …  
    16998 
    17099#if defined SPONGE 
    171       CALL wrk_alloc( jpi, jpj, localviscsponge ) 
    172100      CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    173101 
    … …  
    180108      Agrif_UseSpecialValue = .FALSE. 
    181109 
    182       ubdiff(:,:,:) = (ub(:,:,:) - ztab(:,:,:))*umask(:,:,:) 
     110      ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:) 
    183111 
    184112      ztab = 0.e0 
    … …  
    188116      Agrif_UseSpecialValue = .FALSE. 
    189117 
    190       vbdiff(:,:,:) = (vb(:,:,:) - ztab(:,:,:))*vmask(:,:,:) 
    191  
    192       spongearea = 2 + 2 * Agrif_irhox() 
    193  
    194       localviscsponge = 0. 
    195  
    196       IF (.NOT. spongedoneU) THEN 
    197          spe1ur2(:,:) = 0. 
    198          spe2vr2(:,:) = 0. 
    199  
    200       IF ((nbondi == -1).OR.(nbondi == 2)) THEN 
    201          DO ji = 2, spongearea 
    202             localviscsponge(ji,:) = visc_dyn * (spongearea-ji)/real(spongearea-2) 
    203          ENDDO 
    204      
    205     spe1ur2(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) 
    206  
    207          spe2vr2(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 
    208              localviscsponge(2:spongearea,2:jpj)) 
    209       ENDIF 
    210  
    211       IF ((nbondi == 1).OR.(nbondi == 2)) THEN 
    212          DO ji = nlci-spongearea + 1,nlci-1 
    213             localviscsponge(ji,:) = visc_dyn * (ji - (nlci-spongearea+1))/real(spongearea-2) 
    214          ENDDO 
    215      
    216     spe1ur2(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 
    217            localviscsponge(nlci-spongearea + 2:nlci-1,:)) 
    218  
    219          spe2vr2(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 
    220               + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) 
    221       ENDIF 
    222  
    223  
    224       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    225          DO jj = 2, spongearea 
    226             localviscsponge(:,jj) = visc_dyn * (spongearea-jj)/real(spongearea-2) 
    227          ENDDO 
    228      
    229     spe1ur2(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 
    230            localviscsponge(2:jpi,2:spongearea)) 
    231  
    232          spe2vr2(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 
    233              localviscsponge(:,3:spongearea)) 
    234       ENDIF 
    235  
    236       IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    237          DO jj = nlcj-spongearea + 1,nlcj-1 
    238             localviscsponge(:,jj) = visc_dyn * (jj - (nlcj-spongearea+1))/real(spongearea-2) 
    239          ENDDO 
    240      
    241     spe1ur2(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 
    242             localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) 
    243  
    244          spe2vr2(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 
    245             localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) 
    246       ENDIF 
    247  
    248          spongedoneU = .TRUE. 
    249      
    250      spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:)) 
    251       ENDIF 
    252        
    253       IF (.NOT. spongedoneT) THEN 
    254         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))       
    255       ENDIF 
    256        
    257       DO jk=1,jpkm1 
    258       ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 
    259       vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 
     118      vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:) 
     119 
     120      CALL Agrif_Sponge 
     121 
     122      DO jk = 1,jpkm1 
     123         ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 
     124         vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 
    260125      ENDDO 
    261126       
    … …  
    272137            DO ji = 2, jpim1   ! vector opt. 
    273138               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    274                hdivdiff(ji,jj,jk) =   & 
    275                   (  e2u(ji,jj)*fse3u(ji,jj,jk) * &  
    276                   ubdiff(ji,jj,jk) - e2u(ji-1,jj  )* & 
    277                   fse3u(ji-1,jj  ,jk)  * ubdiff(ji-1,jj  ,jk)       & 
    278                   + e1v(ji,jj)*fse3v(ji,jj,jk) * & 
    279                   vbdiff(ji,jj,jk) - e1v(ji  ,jj-1)* & 
    280                   fse3v(ji  ,jj-1,jk)  * vbdiff(ji  ,jj-1,jk)  ) * zbtr 
     139               hdivdiff(ji,jj,jk) =  (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * ubdiff(ji  ,jj  ,jk)     & 
     140                  &                   - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * ubdiff(ji-1,jj  ,jk)     & 
     141                  &                   + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * vbdiff(ji  ,jj  ,jk)     & 
     142                  &                   - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * vbdiff(ji  ,jj-1,jk)  ) * zbtr 
    281143            END DO 
    282144         END DO 
    … …  
    286148               zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk) 
    287149               rotdiff(ji,jj,jk) = (  e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)    & 
    288                   &              - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) & 
    289                   &           * fmask(ji,jj,jk) * zbtr 
     150                  &                 - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) & 
     151                  &               * fmask(ji,jj,jk) * zbtr 
    290152            END DO 
    291153         END DO 
    … …  
    298160         DO jj = 2, jpjm1 
    299161            DO ji = 2, jpim1   ! vector opt. 
    300                ze2u = rotdiff (ji,jj,jk) 
    301                ze1v = hdivdiff(ji,jj,jk) 
    302162               ! horizontal diffusive trends 
    303                zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    304                   + ( hdivdiff(ji+1,jj,jk) - ze1v      & 
    305                   ) / e1u(ji,jj) 
    306  
    307                zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    308                   + ( hdivdiff(ji,jj+1,jk) - ze1v    & 
    309                   ) / e2v(ji,jj) 
    310  
     163               zua = - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
     164                     + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk) ) / e1u(ji,jj) 
     165 
     166               zva = + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
     167                     + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) / e2v(ji,jj) 
    311168               ! add it to the general momentum trends 
    312169               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    … …  
    317174      END DO                                           !   End of slab 
    318175      !                                                ! =============== 
    319       CALL wrk_dealloc( jpi, jpj, localviscsponge ) 
    320176      CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    321  
    322177#endif 
    323178 
    324179   END SUBROUTINE Agrif_Sponge_dyn 
    325180 
     181   SUBROUTINE Agrif_Sponge 
     182      !!--------------------------------------------- 
     183      !!   *** ROUTINE  Agrif_Sponge *** 
     184      !!--------------------------------------------- 
     185      INTEGER  :: ji,jj,jk 
     186      INTEGER  :: ispongearea, ilci, ilcj 
     187      REAL(wp) :: z1spongearea 
     188      REAL(wp), POINTER, DIMENSION(:,:) :: zlocalviscsponge 
     189 
     190#if defined SPONGE || defined SPONGE_TOP 
     191 
     192      CALL wrk_alloc( jpi, jpj, zlocalviscsponge ) 
     193 
     194      ispongearea  = 2 + 2 * Agrif_irhox() 
     195      ilci = nlci - ispongearea 
     196      ilcj = nlcj - ispongearea  
     197      z1spongearea = 1._wp / REAL( ispongearea - 2 ) 
     198      spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
     199 
     200      ! Tracers 
     201      IF( .NOT. spongedoneT ) THEN 
     202         zlocalviscsponge(:,:) = 0. 
     203         spe1ur(:,:) = 0. 
     204         spe2vr(:,:) = 0. 
     205 
     206         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
     207            DO ji = 2, ispongearea 
     208               zlocalviscsponge(ji,:) = visc_tra * ( ispongearea-ji ) * z1spongearea 
     209            ENDDO 
     210            spe1ur(2:ispongearea-1,:      ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,:      ) + zlocalviscsponge(3:ispongearea,:    ) ) & 
     211               &                         * e2u(2:ispongearea-1,:      ) / e1u(2:ispongearea-1,:      ) 
     212            spe2vr(2:ispongearea  ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea  ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) ) & 
     213               &                         * e1v(2:ispongearea  ,1:jpjm1) / e2v(2:ispongearea  ,1:jpjm1) 
     214         ENDIF 
     215 
     216         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
     217            DO ji = ilci+1,nlci-1 
     218               zlocalviscsponge(ji,:) = visc_tra * (ji - (ilci+1) ) * z1spongearea 
     219            ENDDO 
     220   
     221            spe1ur(ilci+1:nlci-2,:      ) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) )  & 
     222               &                                   * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 
     223 
     224            spe2vr(ilci+1:nlci-1,1:jpjm1) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj  )  ) &  
     225               &                                   * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 
     226         ENDIF 
     227 
     228         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
     229            DO jj = 2, ispongearea 
     230               zlocalviscsponge(:,jj) = visc_tra * ( ispongearea-jj ) * z1spongearea 
     231            ENDDO 
     232            spe1ur(1:jpim1,2:ispongearea  ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) ) & 
     233               &                                * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea) 
     234    
     235            spe2vr(:      ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1)     + zlocalviscsponge(:,3:ispongearea)     ) & 
     236               &                                  * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1) 
     237         ENDIF 
     238 
     239         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
     240            DO jj = ilcj+1,nlcj-1 
     241               zlocalviscsponge(:,jj) = visc_tra * (jj - (ilcj+1) ) * z1spongearea 
     242            ENDDO 
     243            spe1ur(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) & 
     244               &                                * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1) 
     245            spe2vr(:      ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2      ) + zlocalviscsponge(:,ilcj+2:nlcj-1)     ) & 
     246               &                                * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2) 
     247         ENDIF 
     248         spongedoneT = .TRUE. 
     249      ENDIF 
     250 
     251      ! Dynamics 
     252      IF( .NOT. spongedoneU ) THEN 
     253         zlocalviscsponge(:,:) = 0. 
     254         spe1ur2(:,:) = 0. 
     255         spe2vr2(:,:) = 0. 
     256 
     257         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
     258            DO ji = 2, ispongearea 
     259               zlocalviscsponge(ji,:) = visc_dyn * ( ispongearea-ji ) * z1spongearea 
     260            ENDDO 
     261            spe1ur2(2:ispongearea-1,:      ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,:      ) + zlocalviscsponge(3:ispongearea,:    ) ) 
     262            spe2vr2(2:ispongearea  ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea  ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) )  
     263         ENDIF 
     264 
     265         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
     266            DO ji = ilci+1,nlci-1 
     267               zlocalviscsponge(ji,:) = visc_dyn * (ji - (ilci+1) ) * z1spongearea 
     268            ENDDO 
     269            spe1ur2(ilci+1:nlci-2,:      ) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) )   
     270            spe2vr2(ilci+1:nlci-1,1:jpjm1) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj  )  )  
     271         ENDIF 
     272 
     273         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
     274            DO jj = 2, ispongearea 
     275               zlocalviscsponge(:,jj) = visc_dyn * ( ispongearea-jj ) * z1spongearea 
     276            ENDDO 
     277            spe1ur2(1:jpim1,2:ispongearea  ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) )  
     278            spe2vr2(:      ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1)     + zlocalviscsponge(:,3:ispongearea)     ) 
     279         ENDIF 
     280 
     281         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
     282            DO jj = ilcj+1,nlcj-1 
     283               zlocalviscsponge(:,jj) = visc_dyn * (jj - (ilcj+1) ) * z1spongearea 
     284            ENDDO 
     285            spe1ur2(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) )  
     286            spe2vr2(:      ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2      ) + zlocalviscsponge(:,ilcj+2:nlcj-1)     ) 
     287         ENDIF 
     288         spongedoneU = .TRUE. 
     289         spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) ) 
     290      ENDIF 
     291      ! 
     292      CALL wrk_dealloc( jpi, jpj, zlocalviscsponge ) 
     293      ! 
     294#endif 
     295 
     296   END SUBROUTINE Agrif_Sponge 
     297 
    326298   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
    327299      !!--------------------------------------------- 
    328300      !!   *** ROUTINE interptsn *** 
    329301      !!--------------------------------------------- 
    330 #  include "domzgr_substitute.h90"        
    331        
    332302      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    333303      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    341311      !!   *** ROUTINE interpun *** 
    342312      !!--------------------------------------------- 
    343 #  include "domzgr_substitute.h90"        
    344        
    345313      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    346314      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    … …  
    354322      !!   *** ROUTINE interpvn *** 
    355323      !!--------------------------------------------- 
    356 #  include "domzgr_substitute.h90"        
    357        
    358324      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    359325      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r3294 r3653  
    2727 
    2828   SUBROUTINE Agrif_trc 
    29       !!--------------------------------------------- 
    30       !!   *** ROUTINE Agrif_trc *** 
    31       !!--------------------------------------------- 
    32        
    33       INTEGER :: ji,jj,jk,jn 
    34       REAL(wp) :: zrhox 
    35       REAL(wp) :: alpha1, alpha2, alpha3, alpha4 
    36       REAL(wp) :: alpha5, alpha6, alpha7 
     29      !!---------------------------------------------------------------------- 
     30      !!                  ***  ROUTINE Agrif_Tra  *** 
     31      !!---------------------------------------------------------------------- 
     32      !! 
     33      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     34      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3 
     35      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7 
    3736      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 
    38             
    39       IF (Agrif_Root()) RETURN 
     37      !!---------------------------------------------------------------------- 
     38      ! 
     39      IF( Agrif_Root() )   RETURN 
    4040 
    4141      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 
    4242 
    43       Agrif_SpecialValue=0. 
     43      Agrif_SpecialValue    = 0.e0 
    4444      Agrif_UseSpecialValue = .TRUE. 
    45       ztra = 0.e0 
     45      ztra(:,:,:,:) = 0.e0 
    4646 
    47       CALL Agrif_Bc_variable(ztra,trn_id, procname = interptrn ) 
     47      CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn ) 
    4848      Agrif_UseSpecialValue = .FALSE. 
    4949 
    5050      zrhox = Agrif_Rhox() 
    5151 
    52       alpha1 = (zrhox-1.)/2. 
    53       alpha2 = 1.-alpha1 
     52      alpha1 = ( zrhox - 1. ) * 0.5 
     53      alpha2 = 1. - alpha1 
    5454 
    55       alpha3 = (zrhox-1)/(zrhox+1) 
    56       alpha4 = 1.-alpha3 
     55      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     56      alpha4 = 1. - alpha3 
    5757 
    58       alpha6 = 2.*(zrhox-1.)/(zrhox+1.) 
    59       alpha7 = -(zrhox-1)/(zrhox+3) 
     58      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     59      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    6060      alpha5 = 1. - alpha6 - alpha7 
     61      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    6162 
    62       IF ((nbondi == 1).OR.(nbondi == 2)) THEN 
    63          tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:) 
    64          DO jn=1,jptra  
    65             DO jk=1,jpk       
    66                DO jj=1,jpj 
    67                   IF (umask(nlci-2,jj,jk).EQ.0.) THEN 
     63         DO jn = 1, jptra 
     64            tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn) 
     65            DO jk = 1, jpkm1 
     66               DO jj = 1, jpj 
     67                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    6868                     tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    6969                  ELSE 
    7070                     tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    71                      IF (un(nlci-2,jj,jk).GT.0.) THEN 
    72                         tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 
    73                            +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     71                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     72                        tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn)  & 
     73                           &                 + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     74                     ENDIF 
     75                  ENDIF 
     76               END DO 
     77            END DO 
     78         ENDDO 
     79      ENDIF 
     80 
     81      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
     82 
     83         DO jn = 1, jptra 
     84            tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn) 
     85            DO jk = 1, jpkm1 
     86               DO ji = 1, jpi 
     87                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     88                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     89                  ELSE 
     90                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 
     91                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     92                        tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn)  & 
     93                           &                 + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     94                     ENDIF 
     95                  ENDIF 
     96               END DO 
     97            END DO 
     98         ENDDO 
     99      ENDIF 
     100      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
     101         DO jn = 1, jptra 
     102            tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn) 
     103            DO jk = 1, jpkm1 
     104               DO jj = 1, jpj 
     105                  IF( umask(2,jj,jk) == 0.e0 ) THEN 
     106                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
     107                  ELSE 
     108                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 
     109                     IF( un(2,jj,jk) < 0.e0 ) THEN 
     110                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
    74111                     ENDIF 
    75112                  ENDIF 
    … …  
    79116      ENDIF 
    80117 
    81       IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    82          tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:) 
    83          DO jn=1, jptra             
    84             DO jk=1,jpk       
     118      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
     119         DO jn = 1, jptra 
     120            tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn) 
     121            DO jk=1,jpk 
    85122               DO ji=1,jpi 
    86                   IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN 
    87                      tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     123                  IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     124                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
    88125                  ELSE 
    89                      tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    90                      IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN 
    91                         tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 
    92                            +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk) 
     126                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
     127                     IF( vn(ji,2,jk) < 0.e0 ) THEN 
     128                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
    93129                     ENDIF 
    94130                  ENDIF 
    95131               END DO 
    96132            END DO 
    97          END DO 
     133         ENDDO 
    98134      ENDIF 
    99  
    100       IF ((nbondi == -1).OR.(nbondi == 2)) THEN 
    101          tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:) 
    102          DO jn=1, jptra 
    103             DO jk=1,jpk       
    104                DO jj=1,jpj 
    105                   IF (umask(2,jj,jk).EQ.0.) THEN 
    106                      tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
    107                   ELSE 
    108                      tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)         
    109                      IF (un(2,jj,jk).LT.0.) THEN 
    110                         tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) & 
    111                            +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
    112                      ENDIF 
    113                   ENDIF 
    114                END DO 
    115             END DO 
    116          END DO 
    117       ENDIF 
    118  
    119       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    120          tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:) 
    121          DO jn=1, jptra   
    122             DO jk=1,jpk       
    123                DO ji=1,jpi 
    124                   IF (vmask(ji,2,jk).EQ.0.) THEN 
    125                      tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
    126                   ELSE 
    127                      tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
    128                      IF (vn(ji,2,jk) .LT. 0.) THEN 
    129                         tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)& 
    130                            +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
    131                      ENDIF 
    132                   ENDIF 
    133                END DO 
    134             END DO 
    135          END DO 
    136       ENDIF 
    137  
     135      ! 
    138136      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 
     137      ! 
    139138 
    140139   END SUBROUTINE Agrif_trc 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r3294 r3653  
    88   USE in_out_manager 
    99   USE agrif_oce 
     10   USE agrif_opa_sponge 
    1011   USE trc 
    1112   USE lib_mpp 
    … …  
    1718   PUBLIC Agrif_Sponge_Trc, interptrn 
    1819 
     20  !! * Substitutions 
     21#  include "domzgr_substitute.h90" 
    1922   !!---------------------------------------------------------------------- 
    2023   !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    … …  
    2932      !!   *** ROUTINE Agrif_Sponge_Trc *** 
    3033      !!--------------------------------------------- 
    31 #include "domzgr_substitute.h90" 
    3234      !!  
    33       INTEGER :: ji,jj,jk,jl 
    34       INTEGER :: spongearea 
     35      INTEGER :: ji,jj,jk,jn 
    3536      REAL(wp) :: timecoeff 
    3637      REAL(wp) :: ztra, zabe1, zabe2, zbtr 
    37       REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
    38       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab 
     38      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv 
     39      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr 
     40      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff 
    3941 
    4042#if defined SPONGE_TOP 
    41       CALL wrk_alloc( jpi, jpj, localviscsponge ) 
    42       CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab ) 
     43      CALL wrk_alloc( jpi, jpj, ztru, ztrv ) 
     44      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff ) 
    4345 
    4446      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    4648      Agrif_SpecialValue=0. 
    4749      Agrif_UseSpecialValue = .TRUE. 
    48       ztab = 0.e0 
    49       CALL Agrif_Bc_Variable(ztab, tra_id,calledweight=timecoeff,procname=interptrn) 
     50      ztabr = 0.e0 
     51      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn) 
    5052      Agrif_UseSpecialValue = .FALSE. 
    5153 
    52       trbdiff(:,:,:,:) = trb(:,:,:,:) - ztab(:,:,:,:) 
     54      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:) 
    5355 
    54       spongearea = 2 + 2 * Agrif_irhox() 
     56      CALL Agrif_sponge 
    5557 
    56       localviscsponge = 0. 
    57        
    58       IF (.NOT. spongedoneT) THEN 
    59          spe1ur(:,:) = 0. 
    60          spe2vr(:,:) = 0. 
     58      DO jn = 1, jptra 
     59         DO jk = 1, jpkm1 
     60            ! 
     61            DO jj = 1, jpjm1 
     62               DO ji = 1, jpim1 
     63                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
     64                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
     65                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     66                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     67               ENDDO 
     68            ENDDO 
    6169 
    62       IF ((nbondi == -1).OR.(nbondi == 2)) THEN 
    63          DO ji = 2, spongearea 
    64             localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2) 
     70            DO jj = 2,jpjm1 
     71               DO ji = 2,jpim1 
     72                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
     73                  ! horizontal diffusive trends 
     74                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  ) 
     75                  ! add it to the general tracer trends 
     76                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     77               END DO 
     78            END DO 
     79            ! 
    6580         ENDDO 
    66      
    67     spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) & 
    68           * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:) 
    69  
    70          spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 
    71              localviscsponge(2:spongearea,2:jpj)) & 
    72            * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1) 
    73       ENDIF 
    74  
    75       IF ((nbondi == 1).OR.(nbondi == 2)) THEN 
    76          DO ji = nlci-spongearea + 1,nlci-1 
    77             localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2) 
    78          ENDDO 
    79      
    80     spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 
    81            localviscsponge(nlci-spongearea + 2:nlci-1,:)) & 
    82           * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:) 
    83  
    84          spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 
    85               + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) & 
    86            * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1) 
    87       ENDIF 
    88  
    89  
    90       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    91          DO jj = 2, spongearea 
    92             localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2) 
    93          ENDDO 
    94      
    95     spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 
    96            localviscsponge(2:jpi,2:spongearea)) & 
    97           * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea) 
    98  
    99          spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 
    100              localviscsponge(:,3:spongearea)) & 
    101            * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1) 
    102       ENDIF 
    103  
    104       IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    105          DO jj = nlcj-spongearea + 1,nlcj-1 
    106             localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2) 
    107          ENDDO 
    108      
    109     spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 
    110             localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) & 
    111           * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1) 
    112  
    113          spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 
    114             localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) & 
    115            * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2) 
    116       ENDIF 
    117        
    118          spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:)) 
    119  
    120          spongedoneT = .TRUE. 
    121       ENDIF 
    122  
    123       DO jl = 1, jptra 
    124       DO jk = 1, jpkm1 
    125          DO jj = 1, jpjm1 
    126             DO ji = 1, jpim1 
    127                zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
    128                zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
    129                ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jl) - trbdiff(ji,jj,jk,jl) ) 
    130                ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) ) 
    131             ENDDO 
    132          ENDDO 
    133  
    134          DO jj = 2,jpjm1 
    135             DO ji = 2,jpim1 
    136                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    137                ! horizontal diffusive trends 
    138                ztra = zbtr * (  ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl)   & 
    139                   &          + ztrv(ji,jj,jk,jl) - ztrv(ji,jj-1,jk,jl)  ) 
    140                ! add it to the general tracer trends 
    141                tra(ji,jj,jk,jl) = (tra(ji,jj,jk,jl) + ztra) 
    142             END DO 
    143          END DO 
    144  
    145       ENDDO 
    14681      ENDDO 
    14782  
    148       CALL wrk_dealloc( jpi, jpj, localviscsponge ) 
    149       CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab ) 
     83      CALL wrk_dealloc( jpi, jpj, ztru, ztrv ) 
     84      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr ) 
    15085 
    15186#endif 
    … …  
    15388   END SUBROUTINE Agrif_Sponge_Trc 
    15489 
    155    SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,l1,l2) 
     90   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
    15691      !!--------------------------------------------- 
    15792      !!   *** ROUTINE interptn *** 
    15893      !!--------------------------------------------- 
    159 #  include "domzgr_substitute.h90"        
    160        
    161       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 
    162       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 
    163  
    164       tabres(i1:i2,j1:j2,k1:k2,l1:l2) = trn(i1:i2,j1:j2,k1:k2,l1:l2) 
     94      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     95      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     96      ! 
     97      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
    16598 
    16699   END SUBROUTINE interptrn 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r3294 r3653  
    3838 
    3939#if defined TWO_WAY 
    40       CALL wrk_alloc( jpi, jpj, jpk, jpts, ztra ) 
     40      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 
    4141 
    4242      Agrif_UseSpecialValueInUpdate = .TRUE. 
    … …  
    5252      nbcline_trc = nbcline_trc + 1 
    5353 
    54       CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztra ) 
     54      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 
    5555#endif 
    5656 
    5757   END SUBROUTINE Agrif_Update_Trc 
    5858 
    59    SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,l1,l2,before) 
     59   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
    6060      !!--------------------------------------------- 
    6161      !!   *** ROUTINE UpdateTrc *** 
    6262      !!--------------------------------------------- 
    63 #  include "domzgr_substitute.h90" 
    64  
    65       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 
    66       REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 
     63      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     64      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    6765      LOGICAL, INTENT(in) :: before 
    6866    
    69       INTEGER :: ji,jj,jk,jl 
     67      INTEGER :: ji,jj,jk,jn 
    7068 
    71          IF (before) THEN 
    72             DO jl=l1,l2 
    73                DO jk=k1,k2 
    74                   DO jj=j1,j2 
    75                      DO ji=i1,i2 
    76                         tabres(ji,jj,jk,jl) = trn(ji,jj,jk,jl) 
     69         IF( before ) THEN 
     70            DO jn = n1, n2 
     71               DO jk = k1, k2 
     72                  DO jj = j1, j2 
     73                     DO ji = i1, i2 
     74                        tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    7775                     ENDDO 
    7876                  ENDDO 
    … …  
    8078            ENDDO 
    8179         ELSE 
    82             DO jl=l1,l2 
    83                DO jk=k1,k2 
    84                   DO jj=j1,j2 
    85                      DO ji=i1,i2 
    86                         IF (tabres(ji,jj,jk,jl).NE.0.) THEN 
    87                            trn(ji,jj,jk,jl) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk) 
     80            DO jn = n1, n2 
     81               DO jk = k1, k2 
     82                  DO jj = j1, j2 
     83                     DO ji = i1, i2 
     84                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
     85                           trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    8886                        ENDIF 
    8987                     ENDDO 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

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

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r3294 r3653  
    5252   LOGICAL            ::   ln_degrad  = .false. !: degradation option enabled or not  
    5353 
    54    INTEGER  , PARAMETER ::   jpfld = 19     ! maximum number of files to read 
     54   INTEGER  , PARAMETER ::   jpfld = 20     ! maximum number of files to read 
    5555   INTEGER  , SAVE      ::   jf_tem         ! index of temperature 
    5656   INTEGER  , SAVE      ::   jf_sal         ! index of salinity 
    … …  
    6161   INTEGER  , SAVE      ::   jf_mld         ! index of mixed layer deptht 
    6262   INTEGER  , SAVE      ::   jf_emp         ! index of water flux 
     63   INTEGER  , SAVE      ::   jf_emps        ! index of water flux - concentr/dilution 
    6364   INTEGER  , SAVE      ::   jf_qsr         ! index of solar radiation 
    6465   INTEGER  , SAVE      ::   jf_wnd         ! index of wind speed 
    … …  
    241242      ENDIF 
    242243      ! 
    243       tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)    ! temperature 
    244       tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)    ! salinity 
     244      tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature 
     245      tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity 
    245246      ! 
    246247      CALL eos    ( tsn, rhd, rhop )                                       ! In any case, we need rhop 
    247248      CALL zdf_mxl( kt )                                                   ! In any case, we need mxl  
    248249      ! 
    249       avt(:,:,:)       = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)    ! vertical diffusive coefficient  
    250       un (:,:,:)       = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! u-velocity 
    251       vn (:,:,:)       = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! v-velocity  
     250      avt(:,:,:)       = sf_dyn(jf_avt)%fnow(:,:,:)  * tmask(:,:,:)    ! vertical diffusive coefficient  
     251      un (:,:,:)       = sf_dyn(jf_uwd)%fnow(:,:,:)  * umask(:,:,:)    ! u-velocity 
     252      vn (:,:,:)       = sf_dyn(jf_vwd)%fnow(:,:,:)  * vmask(:,:,:)    ! v-velocity  
    252253      IF( .NOT.ln_dynwzv ) &                                           ! w-velocity read in file  
    253          wn (:,:,:)    = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)     
    254       hmld(:,:)        = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht 
    255       wndm(:,:)        = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1)    ! wind speed - needed for gas exchange 
    256       emp (:,:)        = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
    257       emps(:,:)        = emp(:,:)  
    258       fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)     ! Sea-ice fraction 
    259       qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation 
     254         wn (:,:,:)    = sf_dyn(jf_wwd)%fnow(:,:,:)  * tmask(:,:,:)     
     255      hmld(:,:)        = sf_dyn(jf_mld)%fnow(:,:,1)  * tmask(:,:,1)    ! mixed layer depht 
     256      wndm(:,:)        = sf_dyn(jf_wnd)%fnow(:,:,1)  * tmask(:,:,1)    ! wind speed - needed for gas exchange 
     257      emp (:,:)        = sf_dyn(jf_emp)%fnow(:,:,1)  * tmask(:,:,1)    ! E-P 
     258      emps(:,:)        = sf_dyn(jf_emps)%fnow(:,:,1) * tmask(:,:,1)    ! (E-P)*S 
     259      fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1)  * tmask(:,:,1)    ! Sea-ice fraction 
     260      qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1)  * tmask(:,:,1)    ! solar radiation 
    260261 
    261262      !                                                      ! bbl diffusive coef 
    … …  
    302303         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 ) 
    303304         CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 ) 
     305         CALL prt_ctl(tab2d_1=emp              , clinfo1=' emp     - : ', mask1=tmask, ovlap=1 ) 
    304306         CALL prt_ctl(tab2d_1=emps             , clinfo1=' emps    - : ', mask1=tmask, ovlap=1 ) 
    305307         CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 ) 
    … …  
    328330      CHARACTER(len=100)            ::  cn_dir   !   Root directory for location of core files 
    329331      TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d    ! array of namelist informations on the fields to read 
    330       TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd  ! informations about the fields to be read 
    331       TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl          !   "                                 " 
    332       TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw          !   "                                 " 
     332      TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_emps, sn_ice, sn_qsr  ! informations about the fields to be read 
     333      TYPE(FLD_N) :: sn_wnd, sn_uwd, sn_vwd, sn_wwd, sn_avt , sn_ubl, sn_vbl          !   "                                 " 
     334      TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv , sn_eiw          !   "                                 " 
    333335      ! 
    334336      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad,    & 
    335          &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd,  & 
    336          &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl,          & 
    337          &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw 
     337         &                sn_tem, sn_sal, sn_mld, sn_emp, sn_emps, sn_ice, sn_qsr,   & 
     338         &                sn_wnd, sn_uwd, sn_vwd, sn_wwd, sn_avt , sn_ubl, sn_vbl,    & 
     339         &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv , sn_eiw 
    338340 
    339341      !!---------------------------------------------------------------------- 
    … …  
    347349      sn_sal  = FLD_N( 'dyna_grid_T' ,    120    , 'vosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
    348350      sn_mld  = FLD_N( 'dyna_grid_T' ,    120    , 'somixght' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
    349       sn_emp  = FLD_N( 'dyna_grid_T' ,    120    , 'sowaflcd' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     351      sn_emp  = FLD_N( 'dyna_grid_T' ,    120    , 'sowaflup' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     352      sn_emps = FLD_N( 'dyna_grid_T' ,    120    , 'sowaflcd' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
    350353      sn_ice  = FLD_N( 'dyna_grid_T' ,    120    , 'soicecov' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
    351354      sn_qsr  = FLD_N( 'dyna_grid_T' ,    120    , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
    … …  
    388391      ENDIF 
    389392 
    390       jf_tem = 1   ;   jf_sal = 2   ;  jf_mld = 3   ;  jf_emp = 4   ;   jf_ice = 5   ;   jf_qsr = 6  
    391       jf_wnd = 7   ;   jf_uwd = 8   ;  jf_vwd = 9   ;  jf_wwd = 10  ;   jf_avt = 11  ;   jfld  = 11 
    392       ! 
    393       slf_d(jf_tem) = sn_tem   ;   slf_d(jf_sal) = sn_sal   ;   slf_d(jf_mld) = sn_mld 
    394       slf_d(jf_emp) = sn_emp   ;   slf_d(jf_ice) = sn_ice   ;   slf_d(jf_qsr) = sn_qsr 
    395       slf_d(jf_wnd) = sn_wnd   ;   slf_d(jf_uwd) = sn_uwd   ;   slf_d(jf_vwd) = sn_vwd 
    396       slf_d(jf_wwd) = sn_wwd   ;   slf_d(jf_avt) = sn_avt  
     393      jf_tem = 1   ;   jf_sal = 2   ;  jf_mld = 3   ;  jf_emp = 4   ;   jf_emps = 5   ;  jf_ice = 6   ;   jf_qsr = 7 
     394      jf_wnd = 8   ;   jf_uwd = 9   ;  jf_vwd = 10  ;  jf_wwd = 11  ;   jf_avt  = 12  ;  jfld  = 12 
     395      ! 
     396      slf_d(jf_tem) = sn_tem   ;   slf_d(jf_sal)  = sn_sal   ;   slf_d(jf_mld) = sn_mld 
     397      slf_d(jf_emp) = sn_emp   ;   slf_d(jf_emps) = sn_emps  ;   slf_d(jf_ice) = sn_ice  
     398      slf_d(jf_qsr) = sn_qsr   ;   slf_d(jf_wnd)  = sn_wnd   ;   slf_d(jf_avt) = sn_avt  
     399      slf_d(jf_uwd) = sn_uwd   ;   slf_d(jf_vwd)  = sn_vwd   ;   slf_d(jf_wwd) = sn_wwd 
    397400      ! 
    398401      IF( .NOT.ln_degrad ) THEN     ! no degrad option 
    399402         IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN        ! eiv & bbl 
    400                  jf_ubl  = 12      ;         jf_vbl  = 13      ;         jf_eiw  = 14   ;   jfld = 14 
     403                 jf_ubl  = 13      ;         jf_vbl  = 14      ;         jf_eiw  = 15   ;   jfld = 15 
    401404           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl  ;   slf_d(jf_eiw) = sn_eiw 
    402405         ENDIF 
    403406         IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN   ! no eiv & bbl 
    404                  jf_ubl  = 12      ;         jf_vbl  = 13      ;   jfld = 13 
     407                 jf_ubl  = 13      ;         jf_vbl  = 14      ;   jfld = 14 
    405408           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    406409         ENDIF 
    407410         IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN   ! eiv & no bbl 
    408            jf_eiw = 12   ;   jfld = 12   ;   slf_d(jf_eiw) = sn_eiw 
     411           jf_eiw = 13   ;   jfld = 13   ;   slf_d(jf_eiw) = sn_eiw 
    409412         ENDIF 
    410413      ELSE 
    411               jf_ahu  = 12      ;         jf_ahv  = 13      ;         jf_ahw  = 14   ;   jfld = 14 
     414              jf_ahu  = 13      ;         jf_ahv  = 14      ;         jf_ahw  = 15   ;   jfld = 15 
    412415        slf_d(jf_ahu) = sn_ahu  ;   slf_d(jf_ahv) = sn_ahv  ;   slf_d(jf_ahw) = sn_ahw 
    413416        IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN         ! eiv & bbl 
    414                  jf_ubl  = 15      ;         jf_vbl  = 16       
     417                 jf_ubl  = 16      ;         jf_vbl  = 17       
    415418           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl   
    416                  jf_eiu  = 17      ;         jf_eiv  = 18      ;          jf_eiw  = 19   ;   jfld = 19 
     419                 jf_eiu  = 18      ;         jf_eiv  = 19      ;          jf_eiw  = 20   ;   jfld = 20 
    417420           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;    slf_d(jf_eiw) = sn_eiw 
    418421        ENDIF 
    419422        IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN    ! no eiv & bbl 
    420                  jf_ubl  = 15      ;         jf_vbl  = 16      ;   jfld = 16 
     423                 jf_ubl  = 16      ;         jf_vbl  = 17      ;   jfld = 17 
    421424           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    422425        ENDIF 
    423426        IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN    ! eiv & no bbl 
    424                  jf_eiu  = 15      ;         jf_eiv  = 16      ;         jf_eiw  = 17   ;   jfld = 17 
     427                 jf_eiu  = 16      ;         jf_eiv  = 17      ;         jf_eiw  = 18   ;   jfld = 18 
    425428           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;   slf_d(jf_eiw) = sn_eiw 
    426429        ENDIF 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r3294 r3653  
    3232   USE ioipsl, ONLY :   ymds2ju   ! for calendar 
    3333   USE prtctl          ! Print control 
    34    USE restart         !  
    3534   USE trc_oce, ONLY : lk_offline ! offline flag 
    3635   USE timing          ! Timing 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r3294 r3653  
    3232   USE phycst          ! physical constants 
    3333   USE dtatsd          ! data temperature and salinity   (dta_tsd routine) 
    34    USE restart         ! ocean restart                   (rst_read routine) 
    3534   USE in_out_manager  ! I/O manager 
    3635   USE iom             ! I/O library 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r3294 r3653  
    2727   USE prtctl          ! Print control 
    2828   USE iom             ! I/O library 
    29    USE restart         ! only for lrst_oce 
    3029   USE timing          ! Timing 
    3130 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r3294 r3653  
    4545   USE prtctl          ! Print control 
    4646   USE iom 
    47    USE restart         ! only for lrst_oce 
    4847   USE lib_fortran 
    4948#if defined key_agrif 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r3294 r3653  
    4141   USE in_out_manager  ! I/O manager 
    4242   USE iom             ! IOM library 
    43    USE restart         ! only for lrst_oce 
    4443   USE zdf_oce         ! Vertical diffusion 
    4544   USE wrk_nemo        ! Memory Allocation 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r3294 r3653  
    2020   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    2121   USE iom             ! I/O library 
    22    USE restart         ! only for lrst_oce 
    2322   USE in_out_manager  ! I/O manager 
    2423   USE prtctl          ! Print control 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r3294 r3653  
    8080   !! was in restart but moved here because of the OFF line... better solution should be found... 
    8181   !!---------------------------------------------------------------------- 
    82    INTEGER ::   nitrst   !: time step at which restart file should be written 
     82   INTEGER ::   nitrst                !: time step at which restart file should be written 
     83   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
     84   INTEGER ::   numror, numrow        !: logical unit for cean restart (read and write) 
    8385 
    8486   !!---------------------------------------------------------------------- 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r2528 r3653  
    4343   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1) 
    4444 
    45    INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 50   !: maximum number of simultaneously opened file 
     45   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100   !: maximum number of simultaneously opened file 
    4646   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 360  !: maximum number of variables in one file 
    4747   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r3332 r3653  
    3030   PUBLIC prt_ctl_info    ! called by all subroutines 
    3131   PUBLIC prt_ctl_init    ! called by opa.F90 
     32   PUBLIC sub_dom         ! called by opa.F90 
    3233 
    3334   !!---------------------------------------------------------------------- 
    … …  
    419420         nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    420421 
    421       INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
     422      INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
    422423      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    423424      !!---------------------------------------------------------------------- 
    424425 
     426      ! 
     427      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
     428      ! 
    425429      !  1. Dimension arrays for subdomains 
    426430      ! ----------------------------------- 
    … …  
    438442#endif 
    439443 
    440       ALLOCATE(ilcitl (isplt,jsplt)) 
    441       ALLOCATE(ilcjtl (isplt,jsplt)) 
    442444 
    443445      nrecil  = 2 * jpreci 
    … …  
    512514      ! ------------------------------- 
    513515 
    514       ALLOCATE(iimpptl(isplt,jsplt)) 
    515       ALLOCATE(ijmpptl(isplt,jsplt)) 
    516        
    517516      iimpptl(:,:) = 1 
    518517      ijmpptl(:,:) = 1 
    … …  
    572571      END DO 
    573572      ! 
    574       DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl ) 
     573      ! 
     574      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
     575      ! 
    575576      ! 
    576577   END SUBROUTINE sub_dom 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r3294 r3653  
    2424   USE trdmld_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE domvvl          ! variable volume 
     26   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    2627 
    2728   IMPLICIT NONE 
    … …  
    3132   PUBLIC   rst_write  ! routine called by step module 
    3233   PUBLIC   rst_read   ! routine called by opa  module 
    33  
    34    LOGICAL, PUBLIC ::   lrst_oce =  .FALSE.   !: logical to control the oce restart write  
    35    INTEGER, PUBLIC ::   numror, numrow        !: logical unit for cean restart (read and write) 
    3634 
    3735   !! * Substitutions 
    … …  
    183181      ENDIF 
    184182      !  
    185                      CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields 
    186                      CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      ) 
    187                      CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) ) 
    188                      CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) ) 
    189                      CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    ) 
    190                      CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    191                      CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
    192       IF( lk_vvl )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    193                      ! 
    194                      CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields 
    195                      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      ) 
    196                      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) ) 
    197                      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) ) 
    198                      CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    ) 
    199                      CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   ) 
    200                      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    ) 
    201                      CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density 
     183      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
     184         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields 
     185         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      ) 
     186         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) ) 
     187         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) ) 
     188         CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    ) 
     189         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
     190         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
     191         IF( lk_vvl )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
     192      ELSE 
     193         neuler = 0 
     194      ENDIF 
     195      ! 
     196      CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields 
     197      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      ) 
     198      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) ) 
     199      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) ) 
     200      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    ) 
     201      IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN 
     202         CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    ) 
     203         CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   ) 
     204      ELSE 
     205         CALL div_cur( 0 )                              ! Horizontal divergence & Relative vorticity 
     206      ENDIF 
     207      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
     208         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density 
     209      ELSE 
     210         CALL eos    ( tsn, rhd, rhop )    
     211      ENDIF 
    202212#if defined key_zdfkpp 
    203213      IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN 
    204                      CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly 
    205       ELSE 
    206                      CALL eos( tsn, rhd )   ! compute rhd 
     214         CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly 
     215      ELSE 
     216         CALL eos( tsn, rhd )   ! compute rhd 
    207217      ENDIF 
    208218#endif 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r3294 r3653  
    629629      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    630630      INTEGER                  ::   iw     ! index into wgts array 
    631       !!--------------------------------------------------------------------- 
    632              
     631      INTEGER                  ::   ipdom  ! index of the domain 
     632      !!--------------------------------------------------------------------- 
     633      !       
    633634      ipk = SIZE( sdjf%fnow, 3 ) 
    634  
     635      ! 
    635636      IF( PRESENT(map) ) THEN 
    636637         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) 
    … …  
    643644         ENDIF 
    644645      ELSE 
     646         IF( SIZE(sdjf%fnow, 1) == jpi ) THEN  ;  ipdom = jpdom_data 
     647         ELSE                                  ;  ipdom = jpdom_unknown 
     648         ENDIF 
    645649         SELECT CASE( ipk ) 
    646          CASE(1)    
    647             IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 
    648             ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) ) 
     650         CASE(1) 
     651            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 
     652            ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) ) 
    649653            ENDIF 
    650654         CASE DEFAULT 
    651             IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    652             ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) ) 
     655            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
     656            ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) ) 
    653657            ENDIF 
    654658         END SELECT 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r3294 r3653  
    2020   USE iom             ! IOM library 
    2121   USE lib_mpp         ! MPP library 
    22    USE restart         ! ocean restart 
    2322 
    2423   IMPLICIT NONE 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3294 r3653  
    2929   USE fldread         ! read input fields 
    3030   USE sbc_oce         ! Surface boundary condition: ocean fields 
     31   USE cyclone         ! Cyclone 10m wind form trac of cyclone centres 
    3132   USE sbcdcy          ! surface boundary condition: diurnal cycle 
    3233   USE iom             ! I/O manager library 
    … …  
    186187 
    187188      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
    188       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 
     189      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 
    189190 
    190191#if defined key_cice 
    … …  
    204205    
    205206    
    206    SUBROUTINE blk_oce_core( sf, pst, pu, pv ) 
     207   SUBROUTINE blk_oce_core( kt, sf, pst, pu, pv ) 
    207208      !!--------------------------------------------------------------------- 
    208209      !!                     ***  ROUTINE blk_core  *** 
    … …  
    225226      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
    226227      !!--------------------------------------------------------------------- 
    227       TYPE(fld), INTENT(in), DIMENSION(:)   ::   sf    ! input data 
    228       REAL(wp) , INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
    229       REAL(wp) , INTENT(in), DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s] 
    230       REAL(wp) , INTENT(in), DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s] 
     228      INTEGER  , INTENT(in   )                 ::   kt    ! time step index 
     229      TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data 
     230      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
     231      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s] 
     232      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s] 
    231233      ! 
    232234      INTEGER  ::   ji, jj               ! dummy loop indices 
    … …  
    261263      zwnd_i(:,:) = 0.e0   
    262264      zwnd_j(:,:) = 0.e0 
     265#if defined key_cyclone 
     266# if defined key_vectopt_loop 
     267!CDIR COLLAPSE 
     268# endif 
     269      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add Manu ! 
     270      DO jj = 2, jpjm1 
     271         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     272            sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj) 
     273            sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj) 
     274         END DO 
     275      END DO 
     276#endif 
    263277#if defined key_vectopt_loop 
    264278!CDIR COLLAPSE 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r3413 r3653  
    4141#endif 
    4242   USE geo2ocean       !  
    43    USE restart         ! 
    4443   USE oce   , ONLY : tsn, un, vn 
    4544   USE albedo          ! 
    … …  
    381380         &     srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE.  
    382381      ! 
     382      IF( TRIM( sn_rcv_tau%clvor  ) == 'local grid' ) THEN        ! already on local grid -> no need of the second grid 
     383            srcv(jpr_otx2:jpr_otz2)%laction = .FALSE.  
     384            srcv(jpr_itx2:jpr_itz2)%laction = .FALSE.  
     385            srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid   ! not needed but cleaner... 
     386            srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid   ! not needed but cleaner... 
     387      ENDIF 
     388      ! 
    383389      IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN        ! 'oce and ice' case ocean stress on ocean mesh used 
    384390         srcv(jpr_itx1:jpr_itz2)%laction = .FALSE.    ! ice components not received 
    … …  
    520526      ssnd(jps_tmix)%clname = 'O_TepMix' 
    521527      SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 
     528      CASE( 'none'         )       ! nothing to do 
    522529      CASE( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE. 
    523530      CASE( 'weighted oce and ice' ) 
    … …  
    562569 
    563570      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    564       CASE ( 'ice and snow' )  
     571      CASE( 'none'         )       ! nothing to do 
     572      CASE( 'ice and snow' )  
    565573         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    566574         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    … …  
    568576         ELSE 
    569577            IF ( jpl > 1 ) THEN 
    570                CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
     578CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
    571579            ENDIF 
    572580         ENDIF 
    … …  
    13501358      !                                                      !    Surface temperature    !   in Kelvin 
    13511359      !                                                      ! ------------------------- ! 
    1352       SELECT CASE( sn_snd_temp%cldes) 
    1353       CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
    1354       CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
    1355          SELECT CASE( sn_snd_temp%clcat ) 
    1356          CASE( 'yes' )    
    1357             ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1358          CASE( 'no' ) 
    1359             ztmp3(:,:,:) = 0.0 
     1360      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
     1361         SELECT CASE( sn_snd_temp%cldes) 
     1362         CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
     1363         CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)    
     1364            SELECT CASE( sn_snd_temp%clcat ) 
     1365            CASE( 'yes' )    
     1366               ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1367            CASE( 'no' ) 
     1368               ztmp3(:,:,:) = 0.0 
     1369               DO jl=1,jpl 
     1370                  ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1371               ENDDO 
     1372            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1373            END SELECT 
     1374         CASE( 'mixed oce-ice'        )    
     1375            ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
    13601376            DO jl=1,jpl 
    1361                ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1377               ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    13621378            ENDDO 
    1363          CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1379         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13641380         END SELECT 
    1365       CASE( 'mixed oce-ice'        )    
    1366          ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
    1367          DO jl=1,jpl 
    1368             ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
    1369          ENDDO 
    1370       CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    1371       END SELECT 
    1372       IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1373       IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 
    1374       IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1381         IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1382         IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 
     1383         IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1384      ENDIF 
    13751385      ! 
    13761386      !                                                      ! ------------------------- ! 
    … …  
    13921402      !                                                      ! ------------------------- ! 
    13931403      ! Send ice fraction field  
    1394       SELECT CASE( sn_snd_thick%clcat ) 
    1395          CASE( 'yes' )    
    1396             ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl) 
    1397          CASE( 'no' ) 
    1398             ztmp3(:,:,1) = fr_i(:,:) 
    1399       CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    1400       END SELECT 
    1401       IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 
     1404      IF( ssnd(jps_fice)%laction ) THEN 
     1405         SELECT CASE( sn_snd_thick%clcat ) 
     1406         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl) 
     1407         CASE( 'no'  )   ;   ztmp3(:,:,1    ) = fr_i(:,:      ) 
     1408         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1409         END SELECT 
     1410         CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 
     1411      ENDIF 
    14021412 
    14031413      ! Send ice and snow thickness field  
    1404       SELECT CASE( sn_snd_thick%cldes) 
    1405       CASE( 'weighted ice and snow' )    
    1406          SELECT CASE( sn_snd_thick%clcat ) 
    1407          CASE( 'yes' )    
    1408             ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1409             ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1410          CASE( 'no' ) 
    1411             ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0 
    1412             DO jl=1,jpl 
    1413                ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 
    1414                ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 
    1415             ENDDO 
    1416          CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1414      IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN  
     1415         SELECT CASE( sn_snd_thick%cldes) 
     1416         CASE( 'none'                  )       ! nothing to do 
     1417         CASE( 'weighted ice and snow' )    
     1418            SELECT CASE( sn_snd_thick%clcat ) 
     1419            CASE( 'yes' )    
     1420               ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1421               ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1422            CASE( 'no' ) 
     1423               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0 
     1424               DO jl=1,jpl 
     1425                  ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 
     1426                  ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 
     1427               ENDDO 
     1428            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     1429            END SELECT 
     1430         CASE( 'ice and snow'         )    
     1431            ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
     1432            ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     1433         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    14171434         END SELECT 
    1418       CASE( 'ice and snow'         )    
    1419          ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
    1420          ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
    1421       CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    1422       END SELECT 
    1423       IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 
    1424       IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 
     1435         IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 
     1436         IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 
     1437      ENDIF 
    14251438      ! 
    14261439#if defined key_cpl_carbon_cycle 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r3294 r3653  
    4848   USE in_out_manager   ! I/O manager 
    4949   USE prtctl           ! Print control 
     50 
     51# if defined key_agrif 
     52   USE agrif_ice 
     53   USE agrif_lim2_update 
     54# endif 
    5055 
    5156   IMPLICIT NONE 
    … …  
    101106         ! 
    102107         CALL ice_init_2 
     108         ! 
     109# if defined key_agrif 
     110         IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim2   ! AGRIF: set the meshes 
     111# endif 
    103112      ENDIF 
    104113 
    … …  
    106115      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  ! 
    107116         !                                     !----------------------! 
     117# if defined key_agrif 
     118         IF( .NOT. Agrif_Root() ) lim_nbstep = MOD(lim_nbstep,Agrif_rhot()& 
     119         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 
     120# endif 
    108121         !  Bulk Formulea ! 
    109122         !----------------! 
    … …  
    211224         IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file 
    212225         ! 
     226# if defined key_agrif && defined key_lim2 
     227         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt ) 
     228# endif 
     229         ! 
    213230      ENDIF                                    ! End sea-ice time step only 
    214231      ! 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3421 r3653  
    4545 
    4646   USE prtctl           ! Print control                    (prt_ctl routine) 
    47    USE restart          ! ocean restart 
    4847   USE iom              ! IOM library 
    4948   USE in_out_manager   ! I/O manager 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r3421 r3653  
    2121   USE closea          ! closed seas 
    2222   USE fldread         ! read input field at current time step 
    23    USE restart         ! restart 
    2423   USE in_out_manager  ! I/O manager 
    2524   USE iom             ! I/O module 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r3294 r3653  
    1818   USE sbcapr          ! surface boundary condition: atmospheric pressure 
    1919   USE prtctl          ! Print control                    (prt_ctl routine) 
    20    USE restart         ! ocean restart 
    2120   USE iom 
    2221   USE in_out_manager  ! I/O manager 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r3294 r3653  
    2929   USE diaptr          ! poleward transport diagnostics 
    3030   USE zdf_oce         ! ocean vertical physics 
    31    USE restart         ! ocean restart 
    3231   USE trc_oce         ! share passive tracers/Ocean variables 
    3332   USE lib_mpp         ! MPP library 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r3294 r3653  
    2727   USE iom             ! I/O manager 
    2828   USE fldread         ! read input fields 
    29    USE restart         ! ocean restart 
    3029   USE lib_mpp         ! MPP library 
    3130   USE wrk_nemo       ! Memory Allocation 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r3294 r3653  
    2323   USE in_out_manager  ! I/O manager 
    2424   USE prtctl          ! Print control 
    25    USE restart         ! ocean restart 
    2625   USE sbcrnf          ! River runoff   
    2726   USE sbcmod          ! ln_rnf   

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r3294 r3653  
    3636   USE trdmld_rst      ! restart for diagnosing the ML trends 
    3737   USE prtctl          ! Print control 
    38    USE restart         ! for lrst_oce 
    3938   USE lib_mpp         ! MPP library 
    4039   USE wrk_nemo        ! Memory allocation 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90

    r2528 r3653  
    1212   USE in_out_manager  ! I/O manager 
    1313   USE iom             ! I/O module 
    14    USE restart         ! only for lrst_oce 
    1514 
    1615   IMPLICIT NONE 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r3294 r3653  
    2323   USE phycst         ! physical constants 
    2424   USE zdfmxl         ! mixed layer 
    25    USE restart        ! only for lrst_oce 
    2625   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2726   USE lib_mpp        ! MPP manager 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r2715 r3653  
    2626   USE tranpc          ! convection: non penetrative adjustment 
    2727   USE ldfslp          ! iso-neutral slopes 
    28    USE restart         ! ocean restart 
    2928 
    3029   USE in_out_manager  ! I/O manager 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r3406 r3653  
    4444   USE zdf_oce        ! vertical physics: ocean variables 
    4545   USE zdfmxl         ! vertical physics: mixed layer 
    46    USE restart        ! ocean restart 
    4746   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    4847   USE prtctl         ! Print control 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90

    r2528 r3653  
    1010!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    1111!!---------------------------------------------------------------------- 
     12SUBROUTINE lib_cray 
     13      WRITE(*,*) 'lib_cray: You should not have seen this print! error?' 
     14END SUBROUTINE lib_cray 
     15 
    1216SUBROUTINE wheneq ( i, x, j, t, ind, nn ) 
    1317        IMPLICIT NONE 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3602 r3653  
    116116      !                            !-----------------------! 
    117117#if defined key_agrif 
    118       CALL Agrif_Declare_Var       ! AGRIF: set the meshes 
     118      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
     119      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
    119120# if defined key_top 
    120       CALL Agrif_Declare_Var_Top   ! AGRIF: set the meshes 
     121      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
     122# endif 
     123# if defined key_lim2 
     124      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
    121125# endif 
    122126#endif 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r3294 r3653  
    9595 
    9696   USE stpctl           ! time stepping control            (stp_ctl routine) 
    97    USE restart          ! ocean restart                    (rst_wri routine) 
    9897   USE prtctl           ! Print control                    (prt_ctl routine) 
    9998 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    r2715 r3653  
    66   !! History :   2.0  !  2008-12  (C. Ethe, G. Madec)  revised architecture 
    77   !!---------------------------------------------------------------------- 
    8    USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 
    9    USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER 
    10    USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER 
    11    USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER 
    12  
    138   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES 
    149   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES 
    … …  
    2419   IMPLICIT NONE 
    2520 
    26    INTEGER, PARAMETER ::   jp_lb      = jp_lobster     + jp_pisces     + jp_cfc     !: cum. number of pass. tracers 
    27    INTEGER, PARAMETER ::   jp_lb_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  !: 
    28    INTEGER, PARAMETER ::   jp_lb_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  !: 
    29    INTEGER, PARAMETER ::   jp_lb_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd !: 
     21   INTEGER, PARAMETER ::   jp_lb      = jp_pisces     + jp_cfc     !: cum. number of pass. tracers 
     22   INTEGER, PARAMETER ::   jp_lb_2d   = jp_pisces_2d  + jp_cfc_2d  !: 
     23   INTEGER, PARAMETER ::   jp_lb_3d   = jp_pisces_3d  + jp_cfc_3d  !: 
     24   INTEGER, PARAMETER ::   jp_lb_trd  = jp_pisces_trd + jp_cfc_trd !: 
    3025    
    3126#if defined key_c14b 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r3294 r3653  
    125125         xdecay  = EXP( - xlambda * rdt ) 
    126126         xaccum  = 1._wp -  xdecay 
     127         ! 
     128         IF( ln_rsttr ) THEN 
     129            IF(lwp) WRITE(numout,*) 
     130            IF(lwp) WRITE(numout,*) ' Read specific variables from C14b model ' 
     131            IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     132            CALL iom_get( numrtr, jpdom_autoglo, 'qint_c14', qint_c14 ) 
     133         ENDIF 
     134         ! 
     135         IF(lwp) WRITE(numout,*) 
     136         ! 
    127137      ENDIF 
    128138 
    … …  
    271281      END DO 
    272282 
     283      ! 
     284      IF( lrst_trc ) THEN 
     285         IF(lwp) WRITE(numout,*) 
     286         IF(lwp) WRITE(numout,*) 'trc_sms_c14b : cumulated input function fields written in ocean restart file ',   & 
     287            &                    'at it= ', kt,' date= ', ndastp 
     288         IF(lwp) WRITE(numout,*) '~~~~' 
     289         CALL iom_rstput( kt, nitrst, numrtw, 'qint_c14', qint_c14 ) 
     290      ENDIF 
     291      !     
    273292      IF( ln_diatrc ) THEN 
    274293         IF( lk_iomput ) THEN 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r3294 r3653  
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    12    USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 
    13    USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER 
    14    USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER 
    15    USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER 
    16  
    1712   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES 
    1813   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES 
    … …  
    2217   IMPLICIT NONE 
    2318 
    24    INTEGER, PARAMETER ::   jp_lc      = jp_lobster     + jp_pisces     !: cumulative number of passive tracers 
    25    INTEGER, PARAMETER ::   jp_lc_2d   = jp_lobster_2d  + jp_pisces_2d  !: 
    26    INTEGER, PARAMETER ::   jp_lc_3d   = jp_lobster_3d  + jp_pisces_3d  !: 
    27    INTEGER, PARAMETER ::   jp_lc_trd  = jp_lobster_trd + jp_pisces_trd !: 
     19   INTEGER, PARAMETER ::   jp_lc      = jp_pisces     !: cumulative number of passive tracers 
     20   INTEGER, PARAMETER ::   jp_lc_2d   = jp_pisces_2d  !: 
     21   INTEGER, PARAMETER ::   jp_lc_3d   = jp_pisces_3d  !: 
     22   INTEGER, PARAMETER ::   jp_lc_trd  = jp_pisces_trd !: 
    2823    
    2924#if defined key_cfc 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r3294 r3653  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends 
    15    !!   trc_cfc_cst  :  sets constants for CFC surface forcing computation 
     15   !!   cfc_init     :  sets constants for CFC surface forcing computation 
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce_trc       ! Ocean variables 
    … …  
    9999      ENDIF 
    100100 
    101       IF( kt == nittrc000 )   CALL trc_cfc_cst 
     101      IF( kt == nittrc000 )   CALL cfc_init 
    102102 
    103103      ! Temporal interpolation 
    … …  
    176176         !                                                  !----------------! 
    177177      END DO                                                !  end CFC loop  ! 
    178       !                                                     !----------------! 
     178      ! 
     179      IF( lrst_trc ) THEN 
     180         IF(lwp) WRITE(numout,*) 
     181         IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ',   & 
     182            &                    'at it= ', kt,' date= ', ndastp 
     183         IF(lwp) WRITE(numout,*) '~~~~' 
     184         DO jn = jp_cfc0, jp_cfc1 
     185            CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
     186         END DO 
     187      ENDIF 
     188      !                                               
    179189      IF( ln_diatrc ) THEN 
    180190        ! 
    … …  
    200210 
    201211 
    202    SUBROUTINE trc_cfc_cst 
     212   SUBROUTINE cfc_init 
    203213      !!--------------------------------------------------------------------- 
    204       !!                     ***  trc_cfc_cst  ***   
     214      !!                     ***  cfc_init  ***   
    205215      !! 
    206216      !! ** Purpose : sets constants for CFC model 
    207217      !!--------------------------------------------------------------------- 
     218      INTEGER :: jn 
    208219 
    209220      ! coefficient for CFC11  
    … …  
    245256      sca(4,2) =  -0.067430 
    246257 
    247    END SUBROUTINE trc_cfc_cst 
     258      IF( ln_rsttr ) THEN 
     259         IF(lwp) WRITE(numout,*) 
     260         IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model ' 
     261         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     262         ! 
     263         DO jn = jp_cfc0, jp_cfc1 
     264            CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )  
     265         END DO 
     266      ENDIF 
     267      IF(lwp) WRITE(numout,*) 
     268      ! 
     269   END SUBROUTINE cfc_init 
    248270 
    249271 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90

    r2528 r3653  
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    12    USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 
    13    USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER 
    14    USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER 
    15    USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER 
    16  
    1712   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES 
    1813   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES 
    … …  
    3227   IMPLICIT NONE 
    3328 
    34    INTEGER, PARAMETER ::   jp_lm      = jp_lobster     + jp_pisces     + jp_cfc     + jp_c14b     !:  
    35    INTEGER, PARAMETER ::   jp_lm_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !: 
    36    INTEGER, PARAMETER ::   jp_lm_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !: 
    37    INTEGER, PARAMETER ::   jp_lm_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !: 
     29   INTEGER, PARAMETER ::   jp_lm      = jp_pisces     + jp_cfc     + jp_c14b     !:  
     30   INTEGER, PARAMETER ::   jp_lm_2d   = jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !: 
     31   INTEGER, PARAMETER ::   jp_lm_3d   = jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !: 
     32   INTEGER, PARAMETER ::   jp_lm_trd  = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !: 
    3833 
    3934#if defined key_my_trc 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90

    r2528 r3653  
    22   !!====================================================================== 
    33   !!                      ***  MODULE trcnam_my_trc  *** 
    4    !! TOP :   initialisation of some run parameters for LOBSTER bio-model 
     4   !! TOP :   initialisation of some run parameters for MY_TRC bio-model 
    55   !!====================================================================== 
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r3295 r3653  
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    12    USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 
    13    USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER 
    14    USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER 
    15    USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER 
    1612 
    1713   IMPLICIT NONE 
    1814 
    19    INTEGER, PUBLIC, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC 
    20    INTEGER, PUBLIC, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !: 
    21    INTEGER, PUBLIC, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !: 
    22    INTEGER, PUBLIC, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !: 
     15#if defined key_pisces_reduced 
     16   !!--------------------------------------------------------------------- 
     17   !!   'key_pisces_reduced'   :                                LOBSTER bio-model 
     18   !!--------------------------------------------------------------------- 
     19   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag  
     20   LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .FALSE. !: p4z flag  
     21   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  6      !: number of passive tracers 
     22   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  19     !: additional 2d output  
     23   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =   3     !: additional 3d output  
     24   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   17    !: number of sms trends for PISCES 
    2325 
    24 #if defined key_pisces  &&  defined key_kriest 
     26   ! assign an index in trc arrays for each LOBSTER prognostic variables 
     27   INTEGER, PUBLIC, PARAMETER ::   jpdet     =  1        !: detritus                    [mmoleN/m3] 
     28   INTEGER, PUBLIC, PARAMETER ::   jpzoo     =  2        !: zooplancton concentration   [mmoleN/m3] 
     29   INTEGER, PUBLIC, PARAMETER ::   jpphy     =  3        !: phytoplancton concentration [mmoleN/m3] 
     30   INTEGER, PUBLIC, PARAMETER ::   jpno3     =  4        !: nitrate concentration       [mmoleN/m3] 
     31   INTEGER, PUBLIC, PARAMETER ::   jpnh4     =  5        !: ammonium concentration      [mmoleN/m3] 
     32   INTEGER, PUBLIC, PARAMETER ::   jpdom     =  6        !: dissolved organic matter    [mmoleN/m3] 
     33 
     34   ! productive layer depth 
     35   INTEGER, PUBLIC, PARAMETER ::   jpkb      = 12        !: first vertical layers where biology is active 
     36   INTEGER, PUBLIC, PARAMETER ::   jpkbm1    = jpkb - 1  !: first vertical layers where biology is active 
     37 
     38#elif defined key_pisces  &&  defined key_kriest 
    2539   !!--------------------------------------------------------------------- 
    2640   !!   'key_pisces' & 'key_kriest'                 PISCES bio-model + ??? 
    2741   !!--------------------------------------------------------------------- 
    2842   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag  
     43   LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .TRUE. !: p4z flag  
    2944   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag  
    3045   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers 
    … …  
    3651   !    WARNING: be carefull about the order when reading the restart 
    3752        !   !!gm  this warning should be obsolet with IOM 
    38    INTEGER, PUBLIC, PARAMETER ::   jpdic = jp_lp + 1    !: dissolved inoganic carbon concentration  
    39    INTEGER, PUBLIC, PARAMETER ::   jptal = jp_lp + 2    !: total alkalinity  
    40    INTEGER, PUBLIC, PARAMETER ::   jpoxy = jp_lp + 3    !: oxygen carbon concentration  
    41    INTEGER, PUBLIC, PARAMETER ::   jpcal = jp_lp + 4    !: calcite  concentration  
    42    INTEGER, PUBLIC, PARAMETER ::   jppo4 = jp_lp + 5    !: phosphate concentration  
    43    INTEGER, PUBLIC, PARAMETER ::   jppoc = jp_lp + 6    !: small particulate organic phosphate concentration 
    44    INTEGER, PUBLIC, PARAMETER ::   jpsil = jp_lp + 7    !: silicate concentration 
    45    INTEGER, PUBLIC, PARAMETER ::   jpphy = jp_lp + 8    !: phytoplancton concentration  
    46    INTEGER, PUBLIC, PARAMETER ::   jpzoo = jp_lp + 9    !: zooplancton concentration 
    47    INTEGER, PUBLIC, PARAMETER ::   jpdoc = jp_lp + 10    !: dissolved organic carbon concentration  
    48    INTEGER, PUBLIC, PARAMETER ::   jpdia = jp_lp + 11    !: Diatoms Concentration 
    49    INTEGER, PUBLIC, PARAMETER ::   jpmes = jp_lp + 12    !: Mesozooplankton Concentration 
    50    INTEGER, PUBLIC, PARAMETER ::   jpdsi = jp_lp + 13    !: (big) Silicate Concentration 
    51    INTEGER, PUBLIC, PARAMETER ::   jpfer = jp_lp + 14    !: Iron Concentration 
    52    INTEGER, PUBLIC, PARAMETER ::   jpnum = jp_lp + 15    !: Big iron particles Concentration 
    53    INTEGER, PUBLIC, PARAMETER ::   jpsfe = jp_lp + 16    !: number of particulate organic phosphate concentration 
    54    INTEGER, PUBLIC, PARAMETER ::   jpdfe = jp_lp + 17    !: Diatoms iron Concentration 
    55    INTEGER, PUBLIC, PARAMETER ::   jpgsi = jp_lp + 18    !: Diatoms Silicate Concentration 
    56    INTEGER, PUBLIC, PARAMETER ::   jpnfe = jp_lp + 19    !: Nano iron Concentration 
    57    INTEGER, PUBLIC, PARAMETER ::   jpnch = jp_lp + 20    !: Nano Chlorophyll Concentration 
    58    INTEGER, PUBLIC, PARAMETER ::   jpdch = jp_lp + 21    !: Diatoms Chlorophyll Concentration 
    59    INTEGER, PUBLIC, PARAMETER ::   jpno3 = jp_lp + 22    !: Nitrates Concentration 
    60    INTEGER, PUBLIC, PARAMETER ::   jpnh4 = jp_lp + 23    !: Ammonium Concentration 
     53   INTEGER, PUBLIC, PARAMETER ::   jpdic = 1    !: dissolved inoganic carbon concentration  
     54   INTEGER, PUBLIC, PARAMETER ::   jptal = 2    !: total alkalinity  
     55   INTEGER, PUBLIC, PARAMETER ::   jpoxy = 3    !: oxygen carbon concentration  
     56   INTEGER, PUBLIC, PARAMETER ::   jpcal = 4    !: calcite  concentration  
     57   INTEGER, PUBLIC, PARAMETER ::   jppo4 = 5    !: phosphate concentration  
     58   INTEGER, PUBLIC, PARAMETER ::   jppoc = 6    !: small particulate organic phosphate concentration 
     59   INTEGER, PUBLIC, PARAMETER ::   jpsil = 7    !: silicate concentration 
     60   INTEGER, PUBLIC, PARAMETER ::   jpphy = 8    !: phytoplancton concentration  
     61   INTEGER, PUBLIC, PARAMETER ::   jpzoo = 9    !: zooplancton concentration 
     62   INTEGER, PUBLIC, PARAMETER ::   jpdoc = 10    !: dissolved organic carbon concentration  
     63   INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration 
     64   INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration 
     65   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration 
     66   INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration 
     67   INTEGER, PUBLIC, PARAMETER ::   jpnum = 15    !: Big iron particles Concentration 
     68   INTEGER, PUBLIC, PARAMETER ::   jpsfe = 16    !: number of particulate organic phosphate concentration 
     69   INTEGER, PUBLIC, PARAMETER ::   jpdfe = 17    !: Diatoms iron Concentration 
     70   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: Diatoms Silicate Concentration 
     71   INTEGER, PUBLIC, PARAMETER ::   jpnfe = 19    !: Nano iron Concentration 
     72   INTEGER, PUBLIC, PARAMETER ::   jpnch = 20    !: Nano Chlorophyll Concentration 
     73   INTEGER, PUBLIC, PARAMETER ::   jpdch = 21    !: Diatoms Chlorophyll Concentration 
     74   INTEGER, PUBLIC, PARAMETER ::   jpno3 = 22    !: Nitrates Concentration 
     75   INTEGER, PUBLIC, PARAMETER ::   jpnh4 = 23    !: Ammonium Concentration 
    6176 
    6277#elif defined key_pisces 
    … …  
    6580   !!--------------------------------------------------------------------- 
    6681   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag  
     82   LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .TRUE.  !: p4z flag  
    6783   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag  
    6884   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers 
    … …  
    7490   !    WARNING: be carefull about the order when reading the restart 
    7591        !   !!gm  this warning should be obsolet with IOM 
    76    INTEGER, PUBLIC, PARAMETER ::   jpdic = jp_lp + 1    !: dissolved inoganic carbon concentration  
    77    INTEGER, PUBLIC, PARAMETER ::   jptal = jp_lp + 2    !: total alkalinity  
    78    INTEGER, PUBLIC, PARAMETER ::   jpoxy = jp_lp + 3    !: oxygen carbon concentration  
    79    INTEGER, PUBLIC, PARAMETER ::   jpcal = jp_lp + 4    !: calcite  concentration  
    80    INTEGER, PUBLIC, PARAMETER ::   jppo4 = jp_lp + 5    !: phosphate concentration  
    81    INTEGER, PUBLIC, PARAMETER ::   jppoc = jp_lp + 6    !: small particulate organic phosphate concentration 
    82    INTEGER, PUBLIC, PARAMETER ::   jpsil = jp_lp + 7    !: silicate concentration 
    83    INTEGER, PUBLIC, PARAMETER ::   jpphy = jp_lp + 8    !: phytoplancton concentration  
    84    INTEGER, PUBLIC, PARAMETER ::   jpzoo = jp_lp + 9    !: zooplancton concentration 
    85    INTEGER, PUBLIC, PARAMETER ::   jpdoc = jp_lp + 10    !: dissolved organic carbon concentration  
    86    INTEGER, PUBLIC, PARAMETER ::   jpdia = jp_lp + 11    !: Diatoms Concentration 
    87    INTEGER, PUBLIC, PARAMETER ::   jpmes = jp_lp + 12    !: Mesozooplankton Concentration 
    88    INTEGER, PUBLIC, PARAMETER ::   jpdsi = jp_lp + 13    !: (big) Silicate Concentration 
    89    INTEGER, PUBLIC, PARAMETER ::   jpfer = jp_lp + 14    !: Iron Concentration 
    90    INTEGER, PUBLIC, PARAMETER ::   jpbfe = jp_lp + 15    !: Big iron particles Concentration 
    91    INTEGER, PUBLIC, PARAMETER ::   jpgoc = jp_lp + 16    !: big particulate organic phosphate concentration 
    92    INTEGER, PUBLIC, PARAMETER ::   jpsfe = jp_lp + 17    !: Small iron particles Concentration 
    93    INTEGER, PUBLIC, PARAMETER ::   jpdfe = jp_lp + 18    !: Diatoms iron Concentration 
    94    INTEGER, PUBLIC, PARAMETER ::   jpgsi = jp_lp + 19    !: Diatoms Silicate Concentration 
    95    INTEGER, PUBLIC, PARAMETER ::   jpnfe = jp_lp + 20    !: Nano iron Concentration 
    96    INTEGER, PUBLIC, PARAMETER ::   jpnch = jp_lp + 21    !: Nano Chlorophyll Concentration 
    97    INTEGER, PUBLIC, PARAMETER ::   jpdch = jp_lp + 22    !: Diatoms Chlorophyll Concentration 
    98    INTEGER, PUBLIC, PARAMETER ::   jpno3 = jp_lp + 23    !: Nitrates Concentration 
    99    INTEGER, PUBLIC, PARAMETER ::   jpnh4 = jp_lp + 24    !: Ammonium Concentration 
     92   INTEGER, PUBLIC, PARAMETER ::   jpdic = 1    !: dissolved inoganic carbon concentration  
     93   INTEGER, PUBLIC, PARAMETER ::   jptal = 2    !: total alkalinity  
     94   INTEGER, PUBLIC, PARAMETER ::   jpoxy = 3    !: oxygen carbon concentration  
     95   INTEGER, PUBLIC, PARAMETER ::   jpcal = 4    !: calcite  concentration  
     96   INTEGER, PUBLIC, PARAMETER ::   jppo4 = 5    !: phosphate concentration  
     97   INTEGER, PUBLIC, PARAMETER ::   jppoc = 6    !: small particulate organic phosphate concentration 
     98   INTEGER, PUBLIC, PARAMETER ::   jpsil = 7    !: silicate concentration 
     99   INTEGER, PUBLIC, PARAMETER ::   jpphy = 8    !: phytoplancton concentration  
     100   INTEGER, PUBLIC, PARAMETER ::   jpzoo = 9    !: zooplancton concentration 
     101   INTEGER, PUBLIC, PARAMETER ::   jpdoc = 10    !: dissolved organic carbon concentration  
     102   INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration 
     103   INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration 
     104   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration 
     105   INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration 
     106   INTEGER, PUBLIC, PARAMETER ::   jpbfe = 15    !: Big iron particles Concentration 
     107   INTEGER, PUBLIC, PARAMETER ::   jpgoc = 16    !: big particulate organic phosphate concentration 
     108   INTEGER, PUBLIC, PARAMETER ::   jpsfe = 17    !: Small iron particles Concentration 
     109   INTEGER, PUBLIC, PARAMETER ::   jpdfe = 18    !: Diatoms iron Concentration 
     110   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: Diatoms Silicate Concentration 
     111   INTEGER, PUBLIC, PARAMETER ::   jpnfe = 20    !: Nano iron Concentration 
     112   INTEGER, PUBLIC, PARAMETER ::   jpnch = 21    !: Nano Chlorophyll Concentration 
     113   INTEGER, PUBLIC, PARAMETER ::   jpdch = 22    !: Diatoms Chlorophyll Concentration 
     114   INTEGER, PUBLIC, PARAMETER ::   jpno3 = 23    !: Nitrates Concentration 
     115   INTEGER, PUBLIC, PARAMETER ::   jpnh4 = 24    !: Ammonium Concentration 
    100116 
    101117#else 
    … …  
    103119   !!   Default                                   No CFC geochemical model 
    104120   !!--------------------------------------------------------------------- 
    105    LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .FALSE.  !: CFC flag  
    106    LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE.  !: Kriest flag  
     121   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .FALSE.  !: PISCES flag  
     122   LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .FALSE.  !: p4z flag  
    107123   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  0       !: No CFC tracers 
    108124   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  0       !: No CFC additional 2d output arrays  
    … …  
    112128 
    113129   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 
    114    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0     = jp_lp + 1                  !: First index of PISCES tracers 
    115    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1     = jp_lp + jp_pisces          !: Last  index of PISCES tracers 
    116    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_2d  = jp_lp_2d + 1               !: First index of 2D diag 
    117    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_2d  = jp_lp_2d + jp_pisces_2d    !: Last  index of 2D diag 
    118    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_3d  = jp_lp_3d + 1               !: First index of 3D diag 
    119    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_3d  = jp_lp_3d + jp_pisces_3d    !: Last  index of 3d diag 
    120    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_trd = jp_lp_trd + 1              !: First index of bio diag 
    121    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_trd = jp_lp_trd + jp_pisces_trd  !: Last  index of bio diag 
     130   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0     = 1                  !: First index of PISCES tracers 
     131   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1     = jp_pisces          !: Last  index of PISCES tracers 
     132   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_2d  = 1               !: First index of 2D diag 
     133   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_2d  = jp_pisces_2d    !: Last  index of 2D diag 
     134   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_3d  = 1               !: First index of 3D diag 
     135   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_3d  = jp_pisces_3d    !: Last  index of 3d diag 
     136   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_trd = 1              !: First index of bio diag 
     137   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_trd = jp_pisces_trd  !: Last  index of bio diag 
    122138 
    123139 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r3294 r3653  
    77   !!             3.2  !  2009-04 (C. Ethe & NEMO team) style 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
     9#if defined key_pisces || defined key_pisces_reduced  
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_pisces'                                         PISCES model 
    … …  
    1919   INTEGER ::   numnatp 
    2020 
     21   !!*  Biological fluxes for light : variables shared by pisces & lobster 
     22   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  neln  !: number of T-levels + 1 in the euphotic layer 
     23   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup  !: euphotic layer depth 
     24   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot  !: par (photosynthetic available radiation) 
     25   ! 
     26   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  xksi  !:  LOBSTER : zooplakton closure 
     27   !                                                       !:  PISCES  : silicon dependant half saturation 
     28 
     29#if defined key_pisces  
    2130   !!*  Time variables 
    2231   INTEGER  ::   nrdttrc           !: ??? 
    … …  
    2736 
    2837   !!*  Biological parameters  
     38   INTEGER  ::   niter1max, niter2max   !: Maximum number of iterations for sinking 
    2939   REAL(wp) ::   rno3              !: ??? 
    3040   REAL(wp) ::   o2ut              !: ??? 
    … …  
    3747   REAL(wp) ::   ferat3            !: ??? 
    3848 
    39    !!* Damping  
    40    LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
    41    INTEGER  ::   nn_pisdmp         !: frequency of relaxation or not of nutrients to a mean value 
    42    LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value 
    43                                    !: on close seas 
     49   !!*  diagnostic parameters  
     50   REAL(wp) ::  tpp                !: total primary production 
     51   REAL(wp) ::  t_oce_co2_exp      !: total carbon export 
     52   REAL(wp) ::  t_oce_co2_flx      !: Total ocean carbon flux 
     53   REAL(wp) ::  t_atm_co2_flx      !: global mean of atmospheric pco2 
    4454 
    45    !!*  Biological fluxes for light 
    46    INTEGER , ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::  neln       !: number of T-levels + 1 in the euphotic layer 
    47    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::  heup       !: euphotic layer depth 
     55   !!* restoring 
     56   LOGICAL  ::  ln_pisdmp          !: restoring or not of nutrients to a mean value 
     57   INTEGER  ::  nn_pisdmp          !: frequency of relaxation or not of nutrients to a mean value 
     58   LOGICAL  ::  ln_pisclo          !: Restoring or not of nutrients to initial value on closed seas 
     59 
     60   !!* Mass conservation 
     61   LOGICAL  ::  ln_check_mass      !: Flag to check mass conservation 
    4862 
    4963   !!*  Biological fluxes for primary production 
    50    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksi       !: ??? 
    5164   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksimax    !: ??? 
    5265   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ??? 
    … …  
    6174   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ??? 
    6275   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ??? 
     76   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   biron      !: bioavailable fraction of iron 
    6377 
    6478 
    … …  
    6781   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac    !: ?? 
    6882   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbac    !: ?? 
     83   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbacl   !: ?? 
    6984   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ?? 
    70     REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
    71     REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   grazing    !: Total zooplankton grazing 
     85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
    7286 
    7387   !!* Variable for chemistry of the CO2 cycle 
    … …  
    96110#endif 
    97111 
     112#endif 
    98113   !!---------------------------------------------------------------------- 
    99114   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    111126      !!---------------------------------------------------------------------- 
    112127      ierr(:) = 0 
    113       !*  Biological fluxes for light 
    114       ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                  STAT=ierr(1) ) 
     128      !*  Biological fluxes for light : shared variables for pisces & lobster 
     129      ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj), xksi(jpi,jpj), STAT=ierr(1) ) 
    115130      ! 
     131#if defined key_pisces 
    116132      !*  Biological fluxes for primary production 
    117       ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,       & 
     133      ALLOCATE( xksimax(jpi,jpj)     , biron   (jpi,jpj,jpk),       & 
    118134         &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       & 
    119135         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       & 
    … …  
    121137         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       & 
    122138         &      xlimsi  (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       & 
    123          &      concnfe (jpi,jpj,jpk),                          STAT=ierr(2) )  
     139         &      concnfe (jpi,jpj,jpk),                           STAT=ierr(2) )  
    124140         ! 
    125141      !*  SMS for the organic matter 
    126142      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk),       & 
    127          &      prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk),       & 
    128          &      xlimbac (jpi,jpj,jpk), xdiss  (jpi,jpj,jpk),   STAT=ierr(3) )   
    129          ! 
     143         &      xlimbac (jpi,jpj,jpk), xdiss  (jpi,jpj,jpk),       &  
     144         &      xlimbacl(jpi,jpj,jpk), prodcal(jpi,jpj,jpk),     STAT=ierr(3) ) 
     145 
    130146      !* Variable for chemistry of the CO2 cycle 
    131147      ALLOCATE( akb3(jpi,jpj,jpk)    , ak13  (jpi,jpj,jpk) ,       & 
    132148         &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,       & 
    133149         &      akw3(jpi,jpj,jpk)    , borat (jpi,jpj,jpk) ,       & 
    134          &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,   STAT=ierr(4) ) 
     150         &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,     STAT=ierr(4) ) 
    135151         ! 
    136152      !* Temperature dependancy of SMS terms 
    137       ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,   STAT=ierr(5) ) 
     153      ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,    STAT=ierr(5) ) 
    138154         ! 
    139155      !* Array used to indicate negative tracer values   
    140       ALLOCATE( xnegtr(jpi,jpj,jpk)  ,                          STAT=ierr(6) ) 
     156      ALLOCATE( xnegtr(jpi,jpj,jpk)  ,                           STAT=ierr(6) ) 
     157#endif 
    141158      ! 
    142159      sms_pisces_alloc = MAXVAL( ierr ) 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r3295 r3653  
    99   !!             1.0  !  2005-03  (O. Aumont, A. El Moussaoui) F90 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trcini.pisces.h90 
    11    !!---------------------------------------------------------------------- 
    12 #if defined key_pisces 
     11   !!             3.5  !  2012-05  (C. Ethe) Merge PISCES-LOBSTER 
     12   !!---------------------------------------------------------------------- 
     13#if defined key_pisces || defined key_pisces_reduced 
    1314   !!---------------------------------------------------------------------- 
    1415   !!   'key_pisces'                                       PISCES bio-model 
    … …  
    2021   USE trc             !  passive tracers common variables  
    2122   USE sms_pisces      !  PISCES Source Minus Sink variables 
    22    USE p4zche          !  Chemical model 
    23    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    24    USE p4zopt          !  optical model 
    25    USE p4zrem          !  Remineralisation of organic matter 
    26    USE p4zflx          !  Gas exchange 
    27    USE p4zsed          !  Sedimentation 
    28    USE p4zlim          !  Co-limitations of differents nutrients 
    29    USE p4zprod         !  Growth rate of the 2 phyto groups 
    30    USE p4zmicro        !  Sources and sinks of microzooplankton 
    31    USE p4zmeso         !  Sources and sinks of mesozooplankton 
    32    USE p4zmort         !  Mortality terms for phytoplankton 
    33    USE p4zlys          !  Calcite saturation 
    34    USE p4zsed          !  Sedimentation 
    3523 
    3624   IMPLICIT NONE 
    … …  
    3927   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module 
    4028 
    41    REAL(wp) :: sco2   =  2.312e-3_wp 
    42    REAL(wp) :: alka0  =  2.423e-3_wp 
    43    REAL(wp) :: oxyg0  =  177.6e-6_wp  
    44    REAL(wp) :: po4    =  2.174e-6_wp  
    45    REAL(wp) :: bioma0 =  1.000e-8_wp   
    46    REAL(wp) :: silic1 =  91.65e-6_wp   
    47    REAL(wp) :: no3    =  31.04e-6_wp * 7.625_wp 
    4829 
    4930#  include "top_substitute.h90" 
    … …  
    6142      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    6243      !!---------------------------------------------------------------------- 
    63       ! 
    64       INTEGER  ::  ji, jj, jk 
     44 
     45      IF( lk_pisces ) THEN  ;   CALL p4z_ini   !  PISCES 
     46      ELSE                  ;   CALL p2z_ini   !  LOBSTER 
     47      ENDIF 
     48 
     49   END SUBROUTINE trc_ini_pisces 
     50 
     51   SUBROUTINE p4z_ini 
     52      !!---------------------------------------------------------------------- 
     53      !!                   ***  ROUTINE p4z_ini *** 
     54      !! 
     55      !! ** Purpose :   Initialisation of the PISCES biochemical model 
     56      !!---------------------------------------------------------------------- 
     57#if defined key_pisces  
     58      ! 
     59      USE p4zsms          ! Main P4Z routine 
     60      USE p4zche          !  Chemical model 
     61      USE p4zsink         !  vertical flux of particulate matter due to sinking 
     62      USE p4zopt          !  optical model 
     63      USE p4zsbc          !  Boundary conditions 
     64      USE p4zfechem       !  Iron chemistry 
     65      USE p4zrem          !  Remineralisation of organic matter 
     66      USE p4zflx          !  Gas exchange 
     67      USE p4zlim          !  Co-limitations of differents nutrients 
     68      USE p4zprod         !  Growth rate of the 2 phyto groups 
     69      USE p4zmicro        !  Sources and sinks of microzooplankton 
     70      USE p4zmeso         !  Sources and sinks of mesozooplankton 
     71      USE p4zmort         !  Mortality terms for phytoplankton 
     72      USE p4zlys          !  Calcite saturation 
     73      ! 
     74      REAL(wp), SAVE :: sco2   =  2.312e-3_wp 
     75      REAL(wp), SAVE :: alka0  =  2.423e-3_wp 
     76      REAL(wp), SAVE :: oxyg0  =  177.6e-6_wp  
     77      REAL(wp), SAVE :: po4    =  2.174e-6_wp  
     78      REAL(wp), SAVE :: bioma0 =  1.000e-8_wp   
     79      REAL(wp), SAVE :: silic1 =  91.65e-6_wp   
     80      REAL(wp), SAVE :: no3    =  31.04e-6_wp * 7.625_wp 
     81      ! 
     82      INTEGER  ::  ji, jj, jk, ierr 
    6583      REAL(wp) ::  zcaralk, zbicarb, zco3 
    6684      REAL(wp) ::  ztmas, ztmas1 
    6785      !!---------------------------------------------------------------------- 
     86 
    6887      IF(lwp) WRITE(numout,*) 
    69       IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
     88      IF(lwp) WRITE(numout,*) ' p4z_ini :   PISCES biochemical model initialisation' 
    7089      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    7190 
    72       CALL pisces_alloc()                          ! Allocate PISCES arrays 
    73  
     91                                                 ! Allocate PISCES arrays 
     92      ierr =         sms_pisces_alloc()           
     93      ierr = ierr +  p4z_che_alloc() 
     94      ierr = ierr +  p4z_sink_alloc() 
     95      ierr = ierr +  p4z_opt_alloc() 
     96      ierr = ierr +  p4z_prod_alloc() 
     97      ierr = ierr +  p4z_rem_alloc() 
     98      ierr = ierr +  p4z_flx_alloc() 
     99      ! 
     100      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     101      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' ) 
     102      ! 
     103 
     104      CALL p4z_sms_init       !  Maint routine 
    74105      !                                            ! Time-step 
    75106      rfact   = rdttrc(1)                          ! --------- 
    … …  
    132163         xksimax(:,:) = xksi(:,:) 
    133164 
    134       ENDIF 
    135  
    136       IF( .NOT. ln_rsttr ) THEN 
    137165         ! Initialization of chemical variables of the carbon cycle 
    138166         ! -------------------------------------------------------- 
    … …  
    159187      CALL p4z_lim_init       !  co-limitations by the various nutrients 
    160188      CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean. 
     189      CALL p4z_sbc_init       !  boundary conditions 
     190      CALL p4z_fechem_init    !  Iron chemistry 
    161191      CALL p4z_rem_init       !  remineralisation 
    162192      CALL p4z_mort_init      !  phytoplankton mortality  
    163193      CALL p4z_micro_init     !  microzooplankton 
    164194      CALL p4z_meso_init      !  mesozooplankton 
    165       CALL p4z_sed_init       !  sedimentation  
    166195      CALL p4z_lys_init       !  calcite saturation 
    167196      CALL p4z_flx_init       !  gas exchange  
    … …  
    172201      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    173202      IF(lwp) WRITE(numout,*)  
    174       ! 
    175    END SUBROUTINE trc_ini_pisces 
    176  
    177  
    178    SUBROUTINE pisces_alloc 
    179       !!---------------------------------------------------------------------- 
    180       !!                     ***  ROUTINE pisces_alloc *** 
     203#endif 
     204      ! 
     205   END SUBROUTINE p4z_ini 
     206 
     207   SUBROUTINE p2z_ini 
     208      !!---------------------------------------------------------------------- 
     209      !!                   ***  ROUTINE p2z_ini *** 
    181210      !! 
    182       !! ** Purpose :   Allocate all the dynamic arrays of PISCES  
    183       !!---------------------------------------------------------------------- 
    184       ! 
    185       INTEGER :: ierr 
    186       !!---------------------------------------------------------------------- 
    187       ! 
    188       ierr =         sms_pisces_alloc()          ! Start of PISCES-related alloc routines... 
    189       ierr = ierr +  p4z_che_alloc() 
    190       ierr = ierr +  p4z_sink_alloc() 
    191       ierr = ierr +  p4z_opt_alloc() 
    192       ierr = ierr +  p4z_prod_alloc() 
    193       ierr = ierr +  p4z_rem_alloc() 
    194       ierr = ierr +  p4z_sed_alloc() 
    195       ierr = ierr +  p4z_flx_alloc() 
     211      !! ** Purpose :   Initialisation of the LOBSTER biochemical model 
     212      !!---------------------------------------------------------------------- 
     213#if defined key_pisces_reduced  
     214      ! 
     215      USE p2zopt 
     216      USE p2zexp 
     217      USE p2zbio 
     218      USE p2zsed 
     219      ! 
     220      INTEGER  ::  ji, jj, jk, ierr 
     221      !!---------------------------------------------------------------------- 
     222 
     223      IF(lwp) WRITE(numout,*) 
     224      IF(lwp) WRITE(numout,*) ' p2z_ini :   LOBSTER biochemical model initialisation' 
     225      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     226 
     227      ierr =        sms_pisces_alloc()           
     228      ierr = ierr + p2z_exp_alloc() 
    196229      ! 
    197230      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    198       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' ) 
    199       ! 
    200    END SUBROUTINE pisces_alloc 
    201  
     231      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'p2z_ini: unable to allocate LOBSTER arrays' ) 
     232 
     233      ! LOBSTER initialisation for GYRE : init NO3=f(density) by asklod AS Kremeur 2005-07 
     234      ! ---------------------- 
     235      IF( .NOT. ln_rsttr ) THEN             ! in case of  no restart  
     236         trn(:,:,:,jpdet) = 0.1 * tmask(:,:,:) 
     237         trn(:,:,:,jpzoo) = 0.1 * tmask(:,:,:) 
     238         trn(:,:,:,jpnh4) = 0.1 * tmask(:,:,:) 
     239         trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:) 
     240         trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:) 
     241         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3 ) = 2._wp * tmask(:,:,:) 
     242         ELSE WHERE                      ;  trn(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 
     243         END WHERE                        
     244      ENDIF 
     245      !                       !  Namelist read 
     246      CALL p2z_opt_init       !  Optics parameters 
     247      CALL p2z_sed_init       !  sedimentation 
     248      CALL p2z_bio_init       !  biology 
     249      CALL p2z_exp_init       !  export  
     250      ! 
     251      IF(lwp) WRITE(numout,*)  
     252      IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 
     253      IF(lwp) WRITE(numout,*)  
     254#endif 
     255      ! 
     256   END SUBROUTINE p2z_ini 
    202257#else 
    203258   !!---------------------------------------------------------------------- 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r3294 r3653  
    11MODULE trcnam_pisces 
    22   !!====================================================================== 
    3    !!                      ***  MODULE trcnam_lobster  *** 
     3   !!                      ***  MODULE trcnam_pisces  *** 
    44   !! TOP :   initialisation of some run parameters for PISCES bio-model 
    55   !!====================================================================== 
    … …  
    99   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.pisces.h90 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_pisces 
     11#if defined key_pisces || defined key_pisces_reduced 
    1212   !!---------------------------------------------------------------------- 
    1313   !!   'key_pisces'   :                                   PISCES bio-model 
    … …  
    1919   USE trc             ! TOP variables 
    2020   USE sms_pisces      ! sms trends 
     21   USE trdmod_trc_oce 
    2122   USE iom             ! I/O manager 
    2223 
    … …  
    4849      !! 
    4950      INTEGER :: jl, jn 
    50       TYPE(DIAG), DIMENSION(jp_pisces_2d) :: pisdia2d 
    51       TYPE(DIAG), DIMENSION(jp_pisces_3d) :: pisdia3d 
     51      TYPE(DIAG), DIMENSION(jp_pisces_2d)  :: pisdia2d 
     52      TYPE(DIAG), DIMENSION(jp_pisces_3d)  :: pisdia3d 
     53      TYPE(DIAG), DIMENSION(jp_pisces_trd) :: pisdiabio 
     54      CHARACTER(LEN=20)   ::   clname 
    5255      !! 
    53       NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2 
    54 #if defined key_kriest 
    55       NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_mass_min, xkr_mass_max 
     56      NAMELIST/nampisdia/ pisdia3d, pisdia2d     ! additional diagnostics 
     57#if defined key_pisces_reduced 
     58      NAMELIST/nampisdbi/ pisdiabio 
    5659#endif 
    57       NAMELIST/nampisdia/ pisdia3d, pisdia2d     ! additional diagnostics 
    58       NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp, ln_pisclo 
    5960 
    6061      !!---------------------------------------------------------------------- 
    6162 
    6263      IF(lwp) WRITE(numout,*) 
    63       IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelists' 
     64      clname = 'namelist_pisces' 
     65#if defined key_pisces 
     66      IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelist' 
     67#else 
     68      IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read LOBSTER namelist' 
     69#endif 
    6470      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     71      CALL ctl_opn( numnatp, TRIM( clname ), 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    6572 
    66  
    67       !                               ! Open the namelist file 
    68       !                               ! ---------------------- 
    69       CALL ctl_opn( numnatp, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    70  
    71       REWIND( numnatp )                     
    72       READ  ( numnatp, nampisbio ) 
    73  
    74       IF(lwp) THEN                         ! control print 
    75          WRITE(numout,*) ' Namelist : nampisbio' 
    76          WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc 
    77          WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio 
    78          WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort 
    79          WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3 
    80          WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2 
    81       ENDIF 
    82  
    83 #if defined key_kriest 
    84  
    85       !                               ! nampiskrp : kriest parameters 
    86       !                               ! ----------------------------- 
    87       xkr_eta      = 0.62         
    88       xkr_zeta     = 1.62         
    89       xkr_mass_min = 0.0002      
    90       xkr_mass_max = 1.       
    91  
    92       REWIND( numnatp )                     ! read natkriest 
    93       READ  ( numnatp, nampiskrp ) 
    94  
    95       IF(lwp) THEN 
    96          WRITE(numout,*) 
    97          WRITE(numout,*) ' Namelist : nampiskrp' 
    98          WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta 
    99          WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta 
    100          WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min 
    101          WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max 
    102          WRITE(numout,*) 
    103      ENDIF 
    104  
    105  
    106      ! Computation of some variables 
    107      xkr_massp = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta 
    108  
    109 #endif 
    11073      ! 
    11174      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
    … …  
    162125      ENDIF 
    163126 
    164       REWIND( numnatp ) 
    165       READ  ( numnatp, nampisdmp ) 
     127#if defined key_pisces_reduced 
    166128 
    167       IF(lwp) THEN                         ! control print 
    168          WRITE(numout,*) 
    169          WRITE(numout,*) ' Namelist : nampisdmp' 
    170          WRITE(numout,*) '    Relaxation of tracer to glodap mean value             ln_pisdmp      =', ln_pisdmp 
    171          WRITE(numout,*) '    Frequency of Relaxation                               nn_pisdmp      =', nn_pisdmp 
    172          WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo 
    173          WRITE(numout,*) ' ' 
    174       ENDIF 
     129      IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmld_trc ) THEN 
     130         ! 
     131         ! Namelist nampisdbi 
     132         ! ------------------- 
     133         DO jl = 1, jp_pisces_trd 
     134            IF(     jl <  10 ) THEN   ;   WRITE (pisdiabio(jl)%sname,'("BIO_",I1)') jl      ! short name 
     135            ELSEIF (jl < 100 ) THEN   ;   WRITE (pisdiabio(jl)%sname,'("BIO_",I2)') jl 
     136            ELSE                      ;   WRITE (pisdiabio(jl)%sname,'("BIO_",I3)') jl 
     137            ENDIF 
     138            WRITE(pisdiabio(jl)%lname,'("BIOLOGICAL TREND NUMBER ",I2)') jl                 ! long name 
     139            pisdiabio(jl)%units = 'mmoleN/m3/s '                                            ! units 
     140         END DO 
     141 
     142         REWIND( numnatp ) 
     143         READ  ( numnatp, nampisdbi ) 
     144 
     145         DO jl = 1, jp_pisces_trd 
     146            jn = jp_pcs0_trd + jl - 1 
     147            ctrbio(jl) = pisdiabio(jl)%sname 
     148            ctrbil(jl) = pisdiabio(jl)%lname 
     149            ctrbiu(jl) = pisdiabio(jl)%units 
     150         END DO 
     151 
     152         IF(lwp) THEN                   ! control print 
     153            WRITE(numout,*) 
     154            WRITE(numout,*) ' Namelist : nampisdbi' 
     155            DO jl = 1, jp_pisces_trd 
     156               jn = jp_pcs0_trd + jl - 1 
     157               WRITE(numout,*) '  biological trend No : ', jn, '    short name : ', ctrbio(jn), & 
     158                 &             '  long name  : ', ctrbio(jn), '   unit : ', ctrbio(jn) 
     159            END DO 
     160            WRITE(numout,*) ' ' 
     161         END IF 
     162         ! 
     163      END IF 
     164 
     165#endif 
    175166 
    176167   END SUBROUTINE trc_nam_pisces 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r3320 r3653  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
     9#if defined key_pisces || defined key_pisces_reduced 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_pisces'                                       PISCES bio-model 
    … …  
    1313   !!   trcsms_pisces        :  Time loop of passive tracers sms 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce_trc         !  shared variables between ocean and passive tracers 
    16    USE trc             !  passive tracers common variables  
    17    USE sms_pisces      !  PISCES Source Minus Sink variables 
    18    USE p4zbio          !  Biological model 
    19    USE p4zche          !  Chemical model 
    20    USE p4zlys          !  Calcite saturation 
    21    USE p4zflx          !  Gas exchange 
    22    USE p4zsed          !  Sedimentation 
    23    USE p4zint          !  time interpolation 
    24    USE trdmod_oce      !  Ocean trends variables 
    25    USE trdmod_trc      !  TOP trends variables 
    26    USE sedmodel        !  Sediment model 
    27    USE prtctl_trc      !  print control for debugging 
     15   USE par_pisces 
     16   USE p4zsms 
     17   USE p2zsms 
    2818 
    2919   IMPLICIT NONE 
    … …  
    3121 
    3222   PUBLIC   trc_sms_pisces    ! called in trcsms.F90 
    33  
    34    LOGICAL ::  ln_check_mass = .false.       !: Flag to check mass conservation  
    35  
    36    INTEGER ::  numno3  !: logical unit for NO3 budget 
    37    INTEGER ::  numalk  !: logical unit for talk budget 
    38    INTEGER ::  numsil  !: logical unit for Si budget 
    39  
    4023   !!---------------------------------------------------------------------- 
    4124   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4629CONTAINS 
    4730 
     31      !!---------------------------------------------------------------------- 
     32      !!                   ***  ROUTINE trc_ini_pisces *** 
     33      !! 
     34      !! ** Purpose :   Initialisation of the PISCES biochemical model 
     35      !!---------------------------------------------------------------------- 
     36 
     37 
    4838   SUBROUTINE trc_sms_pisces( kt ) 
    4939      !!--------------------------------------------------------------------- 
    … …  
    5141      !! 
    5242      !! ** Purpose :   Managment of the call to Biological sources and sinks  
    53       !!              routines of PISCES bio-model 
    54       !! 
    55       !! ** Method  : - at each new day ... 
    56       !!              - several calls of bio and sed ??? 
    57       !!              - ... 
    58       !!--------------------------------------------------------------------- 
    59       ! 
    60       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    61       !! 
    62       INTEGER ::   jnt, jn, jl 
    63       CHARACTER (len=25) :: charout 
    64       REAL(wp), POINTER, DIMENSION(:,:,:,:)  :: ztrdpis 
    65       !!--------------------------------------------------------------------- 
    66       ! 
    67       IF( nn_timing == 1 )  CALL timing_start('trc_sms_pisces') 
    68       ! 
    69       IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL trc_sms_pisces_dmp( kt )  ! Relaxation of some tracers 
    70                                                                    CALL trc_sms_pisces_mass_conserv( kt ) ! Mass conservation checking 
    71       IF( l_trdtrc )  THEN 
    72          CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdpis )  
    73          DO jn = 1, jp_pisces 
    74             jl = jn + jp_pcs0 - 1 
    75             ztrdpis(:,:,:,jn) = trn(:,:,:,jl) 
    76          ENDDO 
    77       ENDIF 
    78  
    79       IF( ndayflxtr /= nday_year ) THEN      ! New days 
    80          ! 
    81          ndayflxtr = nday_year 
    82  
    83          IF(lwp) write(numout,*) 
    84          IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year 
    85          IF(lwp) write(numout,*) '~~~~~~' 
    86  
    87          CALL p4z_che              ! computation of chemical constants 
    88          CALL p4z_int              ! computation of various rates for biogeochemistry 
    89          ! 
    90       ENDIF 
    91  
    92  
    93       DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    94          ! 
    95          CALL p4z_bio (kt, jnt)    ! Compute soft tissue production (POC) 
    96          CALL p4z_sed (kt, jnt)    ! compute soft tissue remineralisation 
    97          ! 
    98          DO jn = jp_pcs0, jp_pcs1 
    99             trb(:,:,:,jn) = trn(:,:,:,jn) 
    100          ENDDO 
    101          ! 
    102       END DO 
    103  
    104       IF( l_trdtrc )  THEN 
    105          DO jn = 1, jp_pisces 
    106             jl = jn + jp_pcs0 - 1 
    107             ztrdpis(:,:,:,jn) = ( ztrdpis(:,:,:,jn) - trn(:,:,:,jl) ) * rfact2r 
    108          ENDDO 
    109       ENDIF 
    110  
    111       CALL p4z_lys( kt )             ! Compute CaCO3 saturation 
    112       CALL p4z_flx( kt )             ! Compute surface fluxes 
    113  
    114       DO jn = jp_pcs0, jp_pcs1 
    115         CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
    116         CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 
    117         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. ) 
    118       END DO 
    119  
    120       IF( l_trdtrc ) THEN 
    121          DO jn = 1, jp_pisces 
    122             jl = jn + jp_pcs0 - 1 
    123              ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl) 
    124              CALL trd_mod_trc( ztrdpis(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
    125           END DO 
    126           CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis )  
    127       END IF 
    128  
    129       IF( lk_sed ) THEN  
    130          ! 
    131          CALL sed_model( kt )     !  Main program of Sediment model 
    132          ! 
    133          DO jn = jp_pcs0, jp_pcs1 
    134            CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
    135          END DO 
    136          ! 
    137       ENDIF 
    138       ! 
    139       IF( nn_timing == 1 )  CALL timing_stop('trc_sms_pisces') 
    140       ! 
    141    END SUBROUTINE trc_sms_pisces 
    142  
    143    SUBROUTINE trc_sms_pisces_dmp( kt ) 
    144       !!---------------------------------------------------------------------- 
    145       !!                    ***  trc_sms_pisces_dmp  *** 
    146       !! 
    147       !! ** purpose  : Relaxation of some tracers 
    148       !!---------------------------------------------------------------------- 
    149       ! 
    150       INTEGER, INTENT( in )  ::     kt ! time step 
    151       ! 
    152       REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    153       REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates 
    154       REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate 
    155       REAL(wp) ::  silmean = 91.51     ! mean value of silicate 
    156       ! 
    157       REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 
    158       !!--------------------------------------------------------------------- 
    159  
    160  
    161       IF(lwp)  WRITE(numout,*) 
    162       IF(lwp)  WRITE(numout,*) ' trc_sms_pisces_dmp : Relaxation of nutrients at time-step kt = ', kt 
    163       IF(lwp)  WRITE(numout,*) 
    164  
    165       IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
    166          !                                                    ! --------------------------- ! 
    167          ! set total alkalinity, phosphate, nitrate & silicate 
    168          zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6               
    169  
    170          zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    171          zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122. 
    172          zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6 
    173          zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
    174   
    175          IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum 
    176          trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum 
    177  
    178          IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum 
    179          trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum 
    180  
    181          IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum 
    182          trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum 
    183  
    184          IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum 
    185          trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum ) 
    186          ! 
    187       ENDIF 
    188  
    189    END SUBROUTINE trc_sms_pisces_dmp 
    190  
    191    SUBROUTINE trc_sms_pisces_mass_conserv ( kt ) 
    192       !!---------------------------------------------------------------------- 
    193       !!                  ***  ROUTINE trc_sms_pisces_mass_conserv  *** 
    194       !! 
    195       !! ** Purpose :  Mass conservation check  
     43      !!                routines of PISCES or LOBSTER bio-model 
    19644      !! 
    19745      !!--------------------------------------------------------------------- 
    19846      ! 
    19947      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    200       !! 
    201       REAL(wp) :: zalkbudget, zno3budget, zsilbudget 
     48      !!--------------------------------------------------------------------- 
    20249      ! 
    203       NAMELIST/nampismass/ ln_check_mass 
    204       !!--------------------------------------------------------------------- 
    205  
    206       IF( kt == nittrc000 ) THEN  
    207          REWIND( numnatp )        
    208          READ  ( numnatp, nampismass ) 
    209          IF(lwp) THEN                         ! control print 
    210             WRITE(numout,*) ' ' 
    211             WRITE(numout,*) ' Namelist parameter for mass conservation checking' 
    212             WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    213             WRITE(numout,*) '    Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass 
    214          ENDIF 
    215  
    216          IF( ln_check_mass .AND. lwp) THEN      !   Open budget file of NO3, ALK, Si 
    217             CALL ctl_opn( numno3, 'no3.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    218             CALL ctl_opn( numsil, 'sil.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    219             CALL ctl_opn( numalk, 'talk.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    220          ENDIF 
     50      IF( lk_p4z ) THEN  ;   CALL p4z_sms( kt )   !  PISCES 
     51      ELSE               ;   CALL p2z_sms( kt )   !  LOBSTER 
    22152      ENDIF 
    222  
    223       IF( ln_check_mass ) THEN      !   Compute the budget of NO3, ALK, Si 
    224          zno3budget = glob_sum( (   trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)  & 
    225             &                     + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  & 
    226             &                     + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  & 
    227             &                     + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  & 
    228             &                     + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  )  
    229          !  
    230          zsilbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpgsi)  & 
    231             &                     + trn(:,:,:,jpdsi)                     ) * cvol(:,:,:)  ) 
    232          !  
    233          zalkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              & 
    234             &                     + trn(:,:,:,jptal)                     & 
    235             &                     + trn(:,:,:,jpcal) * 2.                ) * cvol(:,:,:)  ) 
    236  
    237          IF( lwp ) THEN 
    238             WRITE(numno3,9500) kt,  zno3budget / areatot 
    239             WRITE(numsil,9500) kt,  zsilbudget / areatot 
    240             WRITE(numalk,9500) kt,  zalkbudget / areatot 
    241          ENDIF 
    242        ENDIF 
    243  9500  FORMAT(i10,e18.10)      
    244        ! 
    245    END SUBROUTINE trc_sms_pisces_mass_conserv 
     53      ! 
     54   END SUBROUTINE trc_sms_pisces 
    24655 
    24756#else 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90

    r3295 r3653  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && key_pisces && defined key_iomput 
     8#if defined key_top && defined key_iomput && ( defined key_pisces || defined key_pisces_reduced ) 
    99   !!---------------------------------------------------------------------- 
    10    !!   'key_pisces'                                           PISCES model 
     10   !!   'key_pisces or key_pisces_reduced'                     PISCES model 
    1111   !!---------------------------------------------------------------------- 
    1212   !! trc_wri_pisces   :  outputs of concentration fields 
    1313   !!---------------------------------------------------------------------- 
    1414   USE trc         ! passive tracers common variables  
     15   USE sms_pisces  ! PISCES variables 
    1516   USE iom         ! I/O manager 
    1617 
    … …  
    3536      ! write the tracer concentrations in the file 
    3637      ! --------------------------------------- 
    37       DO jn = 1, jptra 
    38          zrfact = 1.0e+6  
    39          IF( jn == jpno3 .OR. jn == jpnh4 ) zrfact = 1.0e+6 / 7.6 
    40          IF( jn == jppo4  )                 zrfact = 1.0e+6 / 122. 
     38#if defined key_pisces_reduced 
     39      DO jn = jp_pcs0, jp_pcs1 
    4140         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    4241         CALL iom_put( cltra, trn(:,:,:,jn) * zrfact ) 
    4342      END DO 
     43#else 
     44      DO jn = jp_pcs0, jp_pcs1 
     45         zrfact = 1.0e+6  
     46         IF( jn == jpno3 .OR. jn == jpnh4 ) zrfact = rno3 * 1.0e+6  
     47         IF( jn == jppo4  )                 zrfact = po4r * 1.0e+6 
     48         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
     49         CALL iom_put( cltra, trn(:,:,:,jn) * zrfact ) 
     50      END DO 
     51#endif 
    4452      ! 
    4553   END SUBROUTINE trc_wri_pisces 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r3294 r3653  
    3434   USE tranxt 
    3535# if defined key_agrif 
    36    USE agrif_top_update 
    3736   USE agrif_top_interp 
    3837# endif 
    … …  
    146145      ENDIF 
    147146 
    148 #if defined key_agrif 
    149       ! Update tracer at AGRIF zoom boundaries 
    150       IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Trc( kt )      ! children only 
    151 #endif       
    152  
    153147      ! trends computation 
    154148      IF( l_trdtrc ) THEN                                      ! trends 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r3294 r3653  
    6363      IF( lk_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0 , jp_cfc1               )  ! CFC model 
    6464      IF( lk_c14b    )   CALL trc_rad_sms( kt, trb, trn, jp_c14b0, jp_c14b1              )  ! bomb C14 
    65       IF( lk_lobster )   CALL trc_rad_sms( kt, trb, trn, jp_lob0 , jp_lob1, cpreserv='Y' )  ! LOBSTER model 
    6665      IF( lk_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' )  ! PISCES model 
    6766      IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1               )  ! MY_TRC model 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r3294 r3653  
    5050      !!            tra = tra + emp * trn / e3t   for k=1 
    5151      !!         where emp, the surface freshwater budget (evaporation minus 
    52       !!         precipitation minus runoff) given in kg/m2/s is divided 
     52      !!         precipitation ) given in kg/m2/s is divided 
    5353      !!         by 1035 kg/m3 (density of ocean water) to obtain m/s. 
    5454      !! 
    … …  
    7979      ENDIF 
    8080 
     81      ! Coupling online : river runoff is added to the horizontal divergence (hdivn) in the subroutine sbc_rnf_div  
     82      ! one only consider the concentration/dilution effect due to evaporation minus precipitation + freezing/melting of sea-ice 
    8183 
    82       IF( lk_offline ) THEN          ! emps in dynamical files contains emps - rnf 
    83          zemps(:,:) = emps(:,:)   
    84       ELSE                           ! Concentration dilution effect on tracer due to evaporation, precipitation, and river runoff 
    85          IF( lk_vvl ) THEN                      ! volume variable 
    86             zemps(:,:) = emps(:,:) - emp(:,:)    
    87 !!ch         zemps(:,:) = 0. 
    88          ELSE                                   ! linear free surface 
    89             IF( ln_rnf ) THEN  ;  zemps(:,:) = emps(:,:) - rnf(:,:)   !  E-P-R 
    90             ELSE               ;  zemps(:,:) = emps(:,:) 
    91             ENDIF  
    92          ENDIF  
     84      ! Coupling in offline, hdivn is computed from ocean horizontal velocities only ; the runoff are not included. 
     85      ! emps in dynamical files contains (emps - rnf) 
     86      IF( .NOT. lk_offline .AND. lk_vvl ) THEN  ! online coupling + volume variable  
     87         zemps(:,:) = emps(:,:) - emp(:,:)    
     88      ELSE 
     89         zemps(:,:) = emps(:,:) 
    9390      ENDIF  
    9491 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r3294 r3653  
    2929 
    3030#if defined key_agrif 
    31    USE agrif_top_sponge ! Momemtum and tracers sponges 
     31   USE agrif_top_sponge ! tracers sponges 
     32   USE agrif_top_update ! tracers updates 
    3233#endif 
    3334 
    … …  
    7677                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
    7778         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     79 
     80#if defined key_agrif 
     81      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only 
     82#endif 
    7883         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive 
    7984                                                                ! tracers at the bottom ocean level 
    … …  
    98103   !!---------------------------------------------------------------------- 
    99104CONTAINS 
    100    SUBROUTINE trc_trp( kt )              ! Empty routine 
    101       INTEGER, INTENT(in) ::   kt 
    102       WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt 
     105   SUBROUTINE trc_trp( kstp )              ! Empty routine 
     106      INTEGER, INTENT(in) ::   kstp 
     107      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp 
    103108   END SUBROUTINE trc_trp 
    104109#endif 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90

    r3320 r3653  
    3434   USE prtctl            ! print control 
    3535   USE sms_pisces        ! PISCES bio-model 
    36    USE sms_lobster       ! LOBSTER bio-model 
    3736   USE wrk_nemo          ! Memory allocation 
    3837 
    … …  
    5352   INTEGER ::   ndimtrd1                         
    5453   INTEGER, SAVE ::  ionce, icount 
    55 #if defined key_lobster 
     54#if defined key_pisces_reduced 
    5655   INTEGER ::   nidtrdbio, nh_tb 
    5756   INTEGER, SAVE ::  ioncebio, icountbio 
    … …  
    6261 
    6362   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   ! 
    64 #if defined key_lobster 
     63#if defined key_pisces_reduced 
    6564   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ztmltrdbio2  ! only needed for mean diagnostics in trd_mld_bio() 
    6665#endif 
    … …  
    8180      !!---------------------------------------------------------------------- 
    8281      ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) ,      & 
    83 #if defined key_lobster 
     82#if defined key_pisces_reduced 
    8483         &      ztmltrdbio2(jpi,jpj,jpdiabio)      ,      & 
    8584#endif 
    … …  
    133132         SELECT CASE ( nn_ctls_trc )                                ! choice of the control surface 
    134133            CASE ( -2  )   ;   STOP 'trdmld_trc : not ready '     !     -> isopycnal surface (see ???) 
    135 #if defined key_pisces || defined key_lobster 
     134#if defined key_pisces || defined key_pisces_reduced 
    136135            CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion 
    137136#endif 
    … …  
    232231      INTEGER                         , INTENT(in) ::   ktrd          ! bio trend index 
    233232      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   ptrc_trdmld   ! passive trc trend 
    234 #if defined key_lobster 
     233#if defined key_pisces_reduced 
    235234      ! 
    236235      INTEGER ::   ji, jj, jk, isum 
    … …  
    940939      !!---------------------------------------------------------------------- 
    941940      INTEGER, INTENT( in ) ::   kt                       ! ocean time-step index 
    942 #if defined key_lobster 
     941#if defined key_pisces_reduced 
    943942      INTEGER  ::  jl, it, itmod 
    944943      LOGICAL  :: llwarn  = .TRUE., lldebug = .TRUE. 
    … …  
    12171216      tmltrd_csum_ln_trc (:,:,:,:) = 0.e0   ;   rmld_sum_trc       (:,:)     = 0.e0 
    12181217 
    1219 #if defined key_lobster 
     1218#if defined key_pisces_reduced 
    12201219      nmoymltrdbio   = 0 
    12211220      tmltrd_sum_bio     (:,:,:) = 0.e0     ;   tmltrd_csum_ln_bio (:,:,:) = 0.e0 
    1222       DO jl = 1, jp_lobster_trd 
     1221      DO jl = 1, jp_pisces_trd 
    12231222          ctrd_bio(jl,1) = ctrbil(jl)   ! long name 
    12241223          ctrd_bio(jl,2) = ctrbio(jl)   ! short name 
    … …  
    12341233         tml_sumb_trc       (:,:,:)   = 0.e0   ;   tmltrd_csum_ub_trc (:,:,:,:) = 0.e0     ! mean 
    12351234         tmltrd_atf_sumb_trc(:,:,:)   = 0.e0   ;   tmltrd_rad_sumb_trc(:,:,:)   = 0.e0  
    1236 #if defined key_lobster 
     1235#if defined key_pisces_reduced 
    12371236         tmltrd_csum_ub_bio (:,:,:) = 0.e0 
    12381237#endif 
    … …  
    12421241      icount = 1   ;   ionce  = 1  ! open specifier    
    12431242 
    1244 #if defined key_lobster 
     1243#if defined key_pisces_reduced 
    12451244      icountbio = 1   ;   ioncebio  = 1  ! open specifier 
    12461245#endif 
    … …  
    13371336      END DO 
    13381337 
    1339 #if defined key_lobster 
     1338#if defined key_pisces_reduced 
    13401339          !-- Create a NetCDF file and enter the define mode 
    13411340          CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' ) 
    … …  
    13831382      END DO 
    13841383 
    1385 #if defined key_lobster 
    1386       DO jl = 1, jp_lobster_trd 
     1384#if defined key_pisces_reduced 
     1385      DO jl = 1, jp_pisces_trd 
    13871386         CALL histdef(nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)), TRIM(clmxl//" ML_"//ctrd_bio(jl,1))   ,            & 
    13881387             &    cltrcu, jpi, jpj, nh_tb, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean 
    … …  
    13951394      END DO 
    13961395 
    1397 #if defined key_lobster 
     1396#if defined key_pisces_reduced 
    13981397      !-- Leave IOIPSL/NetCDF define mode 
    13991398      CALL histend( nidtrdbio, snc4set ) 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90

    r2528 r3653  
    105105            END DO                                                     ! tracer loop 
    106106            !                                                          ! =========== 
    107 #if defined key_lobster 
    108             DO jl = 1, jp_lobster_trd 
     107#if defined key_pisces_reduced 
     108            DO jl = 1, jp_pisces_trd 
    109109               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) ) 
    110110            ENDDO 
    … …  
    190190         !                                                          ! =========== 
    191191 
    192 #if defined key_lobster 
    193          DO jl = 1, jp_lobster_trd 
     192#if defined key_pisces_reduced 
     193         DO jl = 1, jp_pisces_trd 
    194194            CALL iom_get( inum, jpdom_autoglo, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) ) 
    195195         ENDDO 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90

    r3320 r3653  
    106106# endif 
    107107 
    108 # if defined key_lobster 
     108# if defined key_pisces_reduced 
    109109   CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2) 
    110110   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  & 
    … …  
    154154#endif 
    155155      ! 
    156 # if defined key_lobster 
     156# if defined key_pisces_reduced 
    157157      ALLOCATE( tmltrd_bio        (jpi,jpj,jpdiabio) ,     & 
    158158         &      tmltrd_sum_bio    (jpi,jpj,jpdiabio) ,     & 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r3294 r3653  
    5656 
    5757   !* model domain * 
    58    USE dom_oce , ONLY :   lzoom      => lzoom        !: zoom flag 
    59    USE dom_oce , ONLY :   lzoom_e    => lzoom_e      !: East  zoom type flag 
    60    USE dom_oce , ONLY :   lzoom_w    => lzoom_w      !: West  zoom type flag 
    61    USE dom_oce , ONLY :   lzoom_s    => lzoom_s      !: South zoom type flag 
    62    USE dom_oce , ONLY :   lzoom_n    => lzoom_n      !: North zoom type flag 
    63    USE dom_oce , ONLY :   lzoom_arct => lzoom_arct   !: ORCA    arctic zoom flag 
    64    USE dom_oce , ONLY :   lzoom_anta => lzoom_anta   !: ORCA antarctic zoom flag 
    65    USE dom_oce , ONLY :   nperio     =>   nperio     !: type of lateral boundary condition        
    66    USE dom_oce , ONLY :   nimpp      =>   nimpp      !: i index for mpp-subdomain left bottom 
    67    USE dom_oce , ONLY :   njmpp      =>   njmpp      !: j index for mpp-subdomain left bottom 
    68    USE dom_oce , ONLY :   nproc      =>   nproc      !: number for local processor 
    69    USE dom_oce , ONLY :   narea      =>   narea      !: number for local area 
    70    USE dom_oce , ONLY :   mig        =>   mig        !: local  ==> global  domain i-indice 
    71    USE dom_oce , ONLY :   mjg        =>   mjg        !: local  ==> global  domain i-indice 
    72    USE dom_oce , ONLY :   mi0        =>   mi0        !: global ==> local domain i-indice  
    73    USE dom_oce , ONLY :   mi1        =>   mi1        !: (mi0=1 and mi1=0 if the global indice is not in the local one) 
    74    USE dom_oce , ONLY :   mj0        =>   mj0        !: global ==> local domain j-indice  
    75    USE dom_oce , ONLY :   mj1        =>   mj1        !: (mj0=1 and mj1=0 if the global indice is not in the local one) 
    76    USE dom_oce , ONLY :   nidom      =>   nidom 
    77    USE dom_oce , ONLY :   nimppt     => nimppt     !:i-indexes for each processor 
    78    USE dom_oce , ONLY :   njmppt     => njmppt       !:j-indexes for each processor 
    79    USE dom_oce , ONLY :   ibonit     => ibonit       !:i-processor neighbour existence 
    80    USE dom_oce , ONLY :   ibonjt     => ibonjt       !:j- processor neighbour existence  
    81    USE dom_oce , ONLY :   nlci       => nlci         !:i- & j-dimensions of the local subdomain 
    82    USE dom_oce , ONLY :   nlcj       => nlcj         !: 
    83    USE dom_oce , ONLY :   nldi       => nldi         !:first and last indoor i- and j-indexes 
    84    USE dom_oce , ONLY :   nlei       => nlei         !: 
    85    USE dom_oce , ONLY :   nldj       => nldj         !: 
    86    USE dom_oce , ONLY :   nlej       => nlej         !: 
    87    USE dom_oce , ONLY :   nlcit      => nlcit        !:dimensions of every i-subdomain 
    88    USE dom_oce , ONLY :   nlcjt      => nlcjt        !:dimensions of every j-subdomain 
    89    USE dom_oce , ONLY :   nldit      => nldit        !:first indoor index for each i-domain  
    90    USE dom_oce , ONLY :   nleit      => nleit        !:last indoor index for each i-domain  
    91    USE dom_oce , ONLY :   nldjt      => nldjt        !:first indoor index for each j-domain  
    92    USE dom_oce , ONLY :   nlejt      => nlejt        !:last indoor index for each j-domain  
    93   
    94    !* horizontal mesh * 
    95    USE dom_oce , ONLY :   glamt      =>   glamt      !: longitude of t-point (degre)   
    96    USE dom_oce , ONLY :   glamu      =>   glamu      !: longitude of t-point (degre)   
    97    USE dom_oce , ONLY :   glamv      =>   glamv      !: longitude of t-point (degre)   
    98    USE dom_oce , ONLY :   glamf      =>   glamf      !: longitude of t-point (degre)   
    99    USE dom_oce , ONLY :   gphit      =>   gphit      !: latitude  of t-point (degre)    
    100    USE dom_oce , ONLY :   gphiu      =>   gphiu      !: latitude  of t-point (degre)    
    101    USE dom_oce , ONLY :   gphiv      =>   gphiv      !: latitude  of t-point (degre)    
    102    USE dom_oce , ONLY :   gphif      =>   gphif      !: latitude  of t-point (degre)    
    103    USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)   
    104    USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)    
    105    USE dom_oce , ONLY :   e1e2t      =>   e1e2t      !: cell surface at t-point (m2) 
    106    USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m) 
    107    USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m) 
    108    USE dom_oce , ONLY :   e1v        =>   e1v        !: horizontal scale factors at v-point (m) 
    109    USE dom_oce , ONLY :   e2v        =>   e2v        !: horizontal scale factors at v-point (m)   
    110  
    111    !* vertical mesh * 
    112    USE dom_oce , ONLY :   gdept_0    =>   gdept_0    !: reference depth of t-points (m) 
    113    USE dom_oce , ONLY :   e3t_0      =>   e3t_0      !: reference depth of t-points (m)   
    114    USE dom_oce , ONLY :   e3w_0      =>   e3w_0      !: reference depth of w-points (m) 
    115    USE dom_oce , ONLY :   gdepw_0    =>   gdepw_0    !: reference depth of w-points (m) 
    116 # if ! defined key_zco 
    117    USE dom_oce , ONLY :   gdep3w     =>  gdep3w      !: ??? 
    118    USE dom_oce , ONLY :   gdept      =>  gdept       !: depth of t-points (m) 
    119    USE dom_oce , ONLY :   gdepw      =>  gdepw       !: depth of t-points (m) 
    120    USE dom_oce , ONLY :   e3t        =>  e3t         !: vertical scale factors at t- 
    121    USE dom_oce , ONLY :   e3u        =>  e3u         !: vertical scale factors at u- 
    122    USE dom_oce , ONLY :   e3v        =>  e3v         !: vertical scale factors v- 
    123    USE dom_oce , ONLY :   e3w        =>  e3w         !: w-points (m) 
    124    USE dom_oce , ONLY :   e3f        =>  e3f         !: f-points (m) 
    125    USE dom_oce , ONLY :   e3uw       =>  e3uw        !: uw-points (m) 
    126    USE dom_oce , ONLY :   e3vw       =>  e3vw        !: vw-points (m) 
    127 # endif 
    128    USE dom_oce , ONLY :   ln_zps     =>  ln_zps      !: partial steps flag 
    129    USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag 
    130    USE dom_oce , ONLY :   ln_zco     =>  ln_zco      !: z-coordinate flag 
    131    USE dom_oce , ONLY :   hbatt      =>  hbatt       !: ocean depth at the vertical of  t-point (m) 
    132    USE dom_oce , ONLY :   hbatu      =>  hbatu       !: ocean depth at the vertical of  u-point (m) 
    133    USE dom_oce , ONLY :   hbatv      =>  hbatv       !: ocean depth at the vertical of w-point (m) 
    134    USE dom_oce , ONLY :   gsigt      =>  gsigt       !: model level depth coefficient at T-levels 
    135    USE dom_oce , ONLY :   gsigw      =>  gsigw       !: model level depth coefficient at W-levels 
    136    USE dom_oce , ONLY :   gsi3w      =>  gsi3w       !: model level depth coef at w-levels (defined as the sum of e3w) 
    137    USE dom_oce , ONLY :   esigt      =>  esigt       !: vertical scale factor coef. at t-levels 
    138    USE dom_oce , ONLY :   esigw      =>  esigw       !: vertical scale factor coef. at w-levels 
    139    USE dom_oce , ONLY :   lk_vvl     =>  lk_vvl      !: variable grid flag 
    140 # if defined key_vvl 
    141    USE dom_oce , ONLY :   gdep3w_1   =>  gdep3w_1    !: ??? 
    142    USE dom_oce , ONLY :   gdept_1    =>  gdept_1     !: depth of t-points (m) 
    143    USE dom_oce , ONLY :   gdepw_1    =>  gdepw_1     !: depth of t-points (m) 
    144    USE dom_oce , ONLY :   e3t_1      =>  e3t_1       !: vertical scale factors at t- 
    145    USE dom_oce , ONLY :   e3u_1      =>  e3u_1       !: vertical scale factors at u- 
    146    USE dom_oce , ONLY :   e3v_1      =>  e3v_1       !: vertical scale factors v- 
    147    USE dom_oce , ONLY :   e3w_1      =>  e3w_1       !: w-points (m) 
    148    USE dom_oce , ONLY :   e3f_1      =>  e3f_1       !: f-points (m) 
    149    USE dom_oce , ONLY :   e3uw_1     =>  e3uw_1      !: uw-points (m) 
    150    USE dom_oce , ONLY :   e3vw_1     =>  e3vw_1      !: vw-points (m) 
    151 # endif 
    152    !* masks, bathymetry * 
    153    USE dom_oce , ONLY :   mbkt       =>   mbkt       !: vertical index of the bottom last T- ocean level 
    154    USE dom_oce , ONLY :   mbku       =>   mbku       !: vertical index of the bottom last U- ocean level 
    155    USE dom_oce , ONLY :   mbkv       =>   mbkv       !: vertical index of the bottom last V- ocean level 
    156    USE dom_oce , ONLY :   tmask_i    =>   tmask_i    !: Interior mask at t-points 
    157    USE dom_oce , ONLY :   tmask      =>   tmask      !: land/ocean mask at t-points 
    158    USE dom_oce , ONLY :   umask      =>   umask      !: land/ocean mask at u-points    
    159    USE dom_oce , ONLY :   vmask      =>   vmask      !: land/ocean mask at v-points  
    160    USE dom_oce , ONLY :   fmask      =>   fmask      !: land/ocean mask at f-points  
    161  
    162    !* time domain * 
    163    USE dom_oce , ONLY :   neuler     =>   neuler     !: restart euler forward option (0=Euler) 
    164    USE dom_oce , ONLY :   rdt        =>   rdt        !: time step for the dynamics  
    165    USE dom_oce , ONLY :   atfp       =>   atfp       !: asselin time filter parameter 
    166    USE dom_oce , ONLY :   atfp1      =>   atfp1      !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    167    USE dom_oce , ONLY :   rdttra     =>   rdttra     !: vertical profile of tracer time step 
    168    !                                                 !: it is the accumulated duration of previous runs 
    169    !                                                 !: that may have been run with different time steps. 
    170    !* calendar variables * 
    171    USE dom_oce , ONLY :   nyear      =>   nyear      !: current year 
    172    USE dom_oce , ONLY :   nmonth     =>   nmonth     !: current month 
    173    USE dom_oce , ONLY :   nday       =>   nday       !: current day of the month 
    174    USE dom_oce , ONLY :   ndastp     =>   ndastp     !: time step date in yyyymmdd format 
    175    USE dom_oce , ONLY :   nday_year  =>   nday_year  !: current day counted from jan 1st of the current year 
    176    USE dom_oce , ONLY :   nsec_year  =>   nsec_year  !: current time step counted in second since 00h jan 1st of the current year 
    177    USE dom_oce , ONLY :   nsec_month =>   nsec_month !: current time step counted in second since 00h 1st day of the current month 
    178    USE dom_oce , ONLY :   nsec_day   =>   nsec_day   !: current time step counted in second since 00h of the current day 
    179    USE dom_oce , ONLY :   fjulday    =>   fjulday    !: julian day 
    180    USE dom_oce , ONLY :   adatrj     =>   adatrj     !: number of elapsed days since the begining of the whole simulation 
    181                                                      !: (cumulative duration of previous runs  
    182                                                      !: that may have used different time-step size) 
    183    USE dom_oce , ONLY :   nyear_len  =>   nyear_len  !: length in days of the previous/current year 
    184    USE dom_oce , ONLY :   nmonth_len =>   nmonth_len !: length in days of the months of the current year 
     58   USE dom_oce  
    18559 
    18660 
    … …  
    21791   USE oce , ONLY :   grv     =>    grv     !:  
    21892#endif 
    219  
    220    USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection  
    22193 
    22294   !* surface fluxes * 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r2528 r3653  
    55   !!====================================================================== 
    66   !! History :    -   !  1996-01  (M. Levy)  original code 
    7    !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model 
    87   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    98   !!             1.0  !  2004-03  (C. Ethe) Free form and module 
    … …  
    1211   USE par_kind          ! kind parameters 
    1312   ! 
    14    USE par_lobster   ! LOBSTER model 
    1513   USE par_pisces    ! PISCES  model 
    1614   USE par_c14b      ! C14 bomb tracer 
    … …  
    2220   ! Passive tracers : Total size 
    2321   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    24    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_lobster    + jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
    25    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_lobster_2d + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
    26    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_lobster_3d + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     22   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
     23   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
     24   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
    2725   !                     ! total number of sms diagnostic arrays 
    28    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     26   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
    2927    
    3028   !  1D configuration ("key_c1d") 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90

    r3294 r3653  
    1717   USE par_trc          ! TOP parameters 
    1818   USE oce_trc          ! ocean space and time domain variables 
     19   USE prtctl           ! print control for OPA 
    1920 
    2021   IMPLICIT NONE 
    … …  
    296297   END SUBROUTINE prt_ctl_trc_init 
    297298 
    298  
    299    SUBROUTINE sub_dom 
    300       !!---------------------------------------------------------------------- 
    301       !!                  ***  ROUTINE sub_dom  *** 
    302       !!                     
    303       !! ** Purpose :   Lay out the global domain over processors.  
    304       !!                CAUTION:  
    305       !!                This part has been extracted from the mpp_init 
    306       !!                subroutine and names of variables/arrays have been  
    307       !!                slightly changed to avoid confusion but the computation 
    308       !!                is exactly the same. Any modification about indices of 
    309       !!                each sub-domain in the mppini.F90 module should be reported  
    310       !!                here. 
    311       !! 
    312       !! ** Method  :   Global domain is distributed in smaller local domains. 
    313       !!                Periodic condition is a function of the local domain position 
    314       !!                (global boundary or neighbouring domain) and of the global 
    315       !!                periodic 
    316       !!                Type :         jperio global periodic condition 
    317       !!                               nperio local  periodic condition 
    318       !! 
    319       !! ** Action  : - set domain parameters 
    320       !!                    nimpp     : longitudinal index  
    321       !!                    njmpp     : latitudinal  index 
    322       !!                    nperio    : lateral condition type  
    323       !!                    narea     : number for local area 
    324       !!                    nlcil      : first dimension 
    325       !!                    nlcjl      : second dimension 
    326       !!                    nbondil    : mark for "east-west local boundary" 
    327       !!                    nbondjl    : mark for "north-south local boundary" 
    328       !!---------------------------------------------------------------------- 
    329       INTEGER ::   ji, jj, js               ! dummy loop indices 
    330       INTEGER ::   ii, ij                   ! temporary integers 
    331       INTEGER ::   irestil, irestjl         !    "          " 
    332       INTEGER ::   ijpi  , ijpj, nlcil      ! temporary logical unit 
    333       INTEGER ::   nlcjl , nbondil, nbondjl 
    334       INTEGER ::   nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    335       REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    336       INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! temporary workspace 
    337       !!---------------------------------------------------------------------- 
    338       ! 
    339       CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
    340       ! 
    341       ! Dimension arrays for subdomains 
    342       ! ------------------------------- 
    343       !  Computation of local domain sizes ilcitl() ilcjtl() 
    344       !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 
    345       !  The subdomains are squares leeser than or equal to the global 
    346       !  dimensions divided by the number of processors minus the overlap 
    347       !  array (cf. par_oce.F90). 
    348  
    349       ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 
    350       ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
    351  
    352       nrecil  = 2 * jpreci 
    353       nrecjl  = 2 * jprecj 
    354       irestil = MOD( jpiglo - nrecil , isplt ) 
    355       irestjl = MOD( jpjglo - nrecjl , jsplt ) 
    356  
    357       IF(  irestil == 0 )   irestil = isplt 
    358       DO jj = 1, jsplt 
    359          DO ji = 1, irestil 
    360             ilcitl(ji,jj) = ijpi 
    361          END DO 
    362          DO ji = irestil+1, isplt 
    363             ilcitl(ji,jj) = ijpi -1 
    364          END DO 
    365       END DO 
    366        
    367       IF( irestjl == 0 )   irestjl = jsplt 
    368       DO ji = 1, isplt 
    369          DO jj = 1, irestjl 
    370             ilcjtl(ji,jj) = ijpj 
    371          END DO 
    372          DO jj = irestjl+1, jsplt 
    373             ilcjtl(ji,jj) = ijpj -1 
    374          END DO 
    375       END DO 
    376        
    377       zidom = nrecil 
    378       DO ji = 1, isplt 
    379          zidom = zidom + ilcitl(ji,1) - nrecil 
    380       END DO 
    381        
    382       zjdom = nrecjl 
    383       DO jj = 1, jsplt 
    384          zjdom = zjdom + ilcjtl(1,jj) - nrecjl 
    385       END DO 
    386  
    387       ! Index arrays for subdomains 
    388       ! --------------------------- 
    389  
    390       iimpptl(:,:) = 1 
    391       ijmpptl(:,:) = 1 
    392        
    393       IF( isplt > 1 ) THEN 
    394          DO jj = 1, jsplt 
    395             DO ji = 2, isplt 
    396                iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil 
    397             END DO 
    398          END DO 
    399       ENDIF 
    400  
    401       IF( jsplt > 1 ) THEN 
    402          DO jj = 2, jsplt 
    403             DO ji = 1, isplt 
    404                ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl 
    405             END DO 
    406          END DO 
    407       ENDIF 
    408        
    409       ! Subdomain description 
    410       ! --------------------- 
    411  
    412       DO js = 1, ijsplt 
    413          ii = 1 + MOD( js-1, isplt ) 
    414          ij = 1 + (js-1) / isplt 
    415          nimpptl(js) = iimpptl(ii,ij) 
    416          njmpptl(js) = ijmpptl(ii,ij) 
    417          nlcitl (js) = ilcitl (ii,ij)      
    418          nlcil       = nlcitl (js)      
    419          nlcjtl (js) = ilcjtl (ii,ij)      
    420          nlcjl       = nlcjtl (js) 
    421          nbondjl = -1                                    ! general case 
    422          IF( js   >  isplt          )   nbondjl = 0      ! first row of processor 
    423          IF( js   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor 
    424          IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction 
    425          ibonjtl(js) = nbondjl 
    426           
    427          nbondil = 0                                     !  
    428          IF( MOD( js, isplt ) == 1 )   nbondil = -1      ! 
    429          IF( MOD( js, isplt ) == 0 )   nbondil =  1      ! 
    430          IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction 
    431          ibonitl(js) = nbondil 
    432           
    433          nldil =  1   + jpreci 
    434          nleil = nlcil - jpreci 
    435          IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1 
    436          IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil 
    437          nldjl =  1   + jprecj 
    438          nlejl = nlcjl - jprecj 
    439          IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1 
    440          IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl 
    441          nlditl(js) = nldil 
    442          nleitl(js) = nleil 
    443          nldjtl(js) = nldjl 
    444          nlejtl(js) = nlejl 
    445       END DO 
    446       ! 
    447       CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
    448       ! 
    449    END SUBROUTINE sub_dom 
    450   
    451299#else 
    452300   !!---------------------------------------------------------------------- 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r3294 r3653  
    55   !!====================================================================== 
    66   !! History :   OPA  !  1996-01  (M. Levy)  Original code 
    7    !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model 
    87   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    98   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module 
    … …  
    2524   INTEGER, PUBLIC                                                 ::   numnat        !: logicla unit for the passive tracer NAMELIST 
    2625   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics 
     26   INTEGER, PUBLIC                                                 ::   numrtr        !: logical unit for trc restart (read ) 
     27   INTEGER, PUBLIC                                                 ::   numrtw        !: logical unit for trc restart ( write ) 
    2728 
    2829   !! passive tracers fields (before,now,after) 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r3294 r3653  
    2121   USE trcnam          ! Namelist read 
    2222   USE trcini_cfc      ! CFC      initialisation 
    23    USE trcini_lobster  ! LOBSTER  initialisation 
    2423   USE trcini_pisces   ! PISCES   initialisation 
    2524   USE trcini_c14b     ! C14 bomb initialisation 
    … …  
    7069      CALL top_alloc()              ! allocate TOP arrays 
    7170 
    72       IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    & 
    73          &  CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' ) 
     71      IF( ln_dm2dc .AND. lk_pisces )    & 
     72         &  CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES ' ) 
    7473 
    7574      IF( nn_cla == 1 )   & 
    … …  
    101100      areatot = glob_sum( cvol(:,:,:) ) 
    102101 
    103       IF( lk_lobster )       CALL trc_ini_lobster      ! LOBSTER bio-model 
    104102      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
    105103      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 

  • branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r3319 r3653  
    2121   USE trc               ! passive tracers common variables 
    2222   USE trcnam_trp        ! Transport namelist 
    23    USE trcnam_lobster    ! LOBSTER namelist 
    2423   USE trcnam_pisces     ! PISCES namelist 
    2524   USE trcnam_cfc        ! CFC SMS namelist 
    … …