Ignore:
Timestamp:
2017-04-23T09:30:41+02:00 (3 years ago)
Author:
gm
Message:

#1880 (HPC-09): add zdfphy (the ZDF manager) + remove all key_…

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90

    r7761 r7953  
    3131   PRIVATE 
    3232 
    33    PUBLIC agrif_update_lim3 
     33   PUBLIC   agrif_update_lim3   ! called by ???? 
    3434 
    3535   !!---------------------------------------------------------------------- 
    36    !! NEMO/NST 3.6 , LOCEAN-IPSL (2016) 
     36   !! NEMO/NST 4.0 , LOCEAN-IPSL (2017) 
    3737   !! $Id: agrif_lim3_update.F90 6204 2016-01-04 13:47:06Z cetlod $ 
    3838   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 
    40  
    4140CONTAINS 
    4241 
     
    4948      !!---------------------------------------------------------------------- 
    5049      INTEGER, INTENT(in) :: kt 
    51       !! 
    5250      !!---------------------------------------------------------------------- 
    5351      ! 
     
    5755                                                                                                                           ! i.e. update only at the parent time step 
    5856      Agrif_UseSpecialValueInUpdate = .TRUE. 
    59       Agrif_SpecialValueFineGrid = -9999. 
     57      Agrif_SpecialValueFineGrid    = -9999. 
    6058# if defined TWO_WAY 
    6159      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps 
     
    7573 
    7674 
    77    !!------------------ 
    78    !! Local subroutines 
    79    !!------------------ 
    8075   SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before ) 
    8176      !!----------------------------------------------------------------------- 
     
    8479      !!              the properties per mass on the coarse grid 
    8580      !!----------------------------------------------------------------------- 
    86       INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2 
    87       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    88       LOGICAL , INTENT(in) :: before 
     81      INTEGER                               , INTENT(in   ) ::  i1, i2, j1, j2, k1, k2 
     82      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     83      LOGICAL                               , INTENT(in   ) ::  before 
    8984      !! 
    9085      INTEGER  :: jk, jl, jm 
     
    9489         jm = 1 
    9590         DO jl = 1, jpl 
    96             ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    97             ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    98             ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    99             ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 
    100             ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1 
     91            ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     92            ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     93            ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     94            ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl)   ;  jm = jm + 1 
     95            ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl)   ;  jm = jm + 1 
    10196            DO jk = 1, nlay_s 
    102                ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    103             ENDDO 
     97               ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;  jm = jm + 1 
     98            END DO 
    10499            DO jk = 1, nlay_i 
    105                ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    106             ENDDO 
    107          ENDDO 
     100               ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;  jm = jm + 1 
     101            END DO 
     102         END DO 
    108103 
    109104         DO jk = k1, k2 
    110105            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999. 
    111          ENDDO 
    112                    
     106         END DO 
     107         !        
    113108      ELSE 
    114109         jm = 1 
    115110         DO jl = 1, jpl 
    116             a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    117             v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    118             v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    119             smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    120             oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
     111            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     112            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     113            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     114            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     115            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
    121116            DO jk = 1, nlay_s 
    122                e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
     117               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
    123118            ENDDO 
    124119            DO jk = 1, nlay_i 
    125                e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    126             ENDDO 
    127          ENDDO 
     120               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;  jm = jm + 1 
     121            END DO 
     122         END DO 
    128123 
    129124         ! integrated values 
     
    144139      !! ** Method  : Update the fluxes and recover the properties (C-grid) 
    145140      !!----------------------------------------------------------------------- 
    146       INTEGER , INTENT(in) :: i1, i2, j1, j2 
    147       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    148       LOGICAL , INTENT(in) :: before 
     141      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     142      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     143      LOGICAL                         , INTENT(in   ) ::  before 
    149144      !! 
    150       REAL(wp) :: zrhoy 
     145      REAL(wp) ::   zrhoy   ! local scalar 
    151146      !!----------------------------------------------------------------------- 
    152147      ! 
     
    154149         zrhoy = Agrif_Rhoy() 
    155150         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 
    156          WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     151         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(:,:) = -9999. 
    157152      ELSE 
    158153         u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 
     
    167162      !! ** Method  : Update the fluxes and recover the properties (C-grid) 
    168163      !!----------------------------------------------------------------------- 
    169       INTEGER , INTENT(in) :: i1,i2,j1,j2 
    170       REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: ptab 
    171       LOGICAL , INTENT(in) :: before 
     164      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     165      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::  ptab 
     166      LOGICAL                         , INTENT(in   ) ::  before 
    172167      !! 
    173       REAL(wp) :: zrhox 
     168      REAL(wp) ::   zrhox   ! local scalar 
    174169      !!----------------------------------------------------------------------- 
    175170      ! 
     
    177172         zrhox = Agrif_Rhox() 
    178173         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 
    179          WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     174         WHERE( vmask(i1:i2,j1:j2,1) == 0. )   ptab(:,:) = -9999. 
    180175      ELSE 
    181176         v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 
     
    185180 
    186181#else 
     182   !!---------------------------------------------------------------------- 
     183   !!   Empty module                                             no sea-ice 
     184   !!---------------------------------------------------------------------- 
    187185CONTAINS 
    188186   SUBROUTINE agrif_lim3_update_empty 
    189       !!--------------------------------------------- 
    190       !!   *** ROUTINE agrif_lim3_update_empty *** 
    191       !!--------------------------------------------- 
    192187      WRITE(*,*)  'agrif_lim3_update : You should not have seen this print! error?' 
    193188   END SUBROUTINE agrif_lim3_update_empty 
    194189#endif 
     190 
     191   !!====================================================================== 
    195192END MODULE agrif_lim3_update 
Note: See TracChangeset for help on using the changeset viewer.