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 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90 – NEMO

Ignore:
Timestamp:
2017-12-13T15:58:53+01:00 (6 years ago)
Author:
timgraham
Message:

Merge of dev_CNRS_2017 into branch

File:
1 edited

Legend:

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

    r7761 r9019  
    3131   PRIVATE 
    3232 
    33    PUBLIC agrif_update_lim3 
    34  
    35    !!---------------------------------------------------------------------- 
    36    !! NEMO/NST 3.6 , LOCEAN-IPSL (2016) 
     33   PUBLIC   agrif_update_lim3   ! called by agrif_user.F90 
     34 
     35   !!---------------------------------------------------------------------- 
     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      ! 
     
    5654      IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 
    5755                                                                                                                           ! i.e. update only at the parent time step 
     56      IF( nn_ice == 0 ) RETURN   ! do not update if child domain does not have ice 
     57      ! 
     58      Agrif_SpecialValueFineGrid    = -9999. 
    5859      Agrif_UseSpecialValueInUpdate = .TRUE. 
    59       Agrif_SpecialValueFineGrid = -9999. 
    6060# if defined TWO_WAY 
    6161      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps 
     
    7070      ENDIF 
    7171# endif 
     72      Agrif_SpecialValueFineGrid    = 0. 
    7273      Agrif_UseSpecialValueInUpdate = .FALSE. 
    7374      ! 
     
    7576 
    7677 
    77    !!------------------ 
    78    !! Local subroutines 
    79    !!------------------ 
    8078   SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before ) 
    8179      !!----------------------------------------------------------------------- 
     
    8482      !!              the properties per mass on the coarse grid 
    8583      !!----------------------------------------------------------------------- 
    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 
    89       !! 
    90       INTEGER  :: jk, jl, jm 
     84      INTEGER                               , INTENT(in   ) ::  i1, i2, j1, j2, k1, k2 
     85      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     86      LOGICAL                               , INTENT(in   ) ::  before 
     87      !! 
     88      INTEGER  :: ji, jj, jk, jl, jm 
    9189      !!----------------------------------------------------------------------- 
    9290      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean). 
     
    9492         jm = 1 
    9593         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 
     94            ptab(i1:i2,j1:j2,jm  ) = a_i (i1:i2,j1:j2,jl) 
     95            ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl) 
     96            ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl) 
     97            ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl) 
     98            ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl) 
     99            jm = jm + 5 
    101100            DO jk = 1, nlay_s 
    102                ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    103             ENDDO 
     101               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;  jm = jm + 1 
     102            END DO 
    104103            DO jk = 1, nlay_i 
    105                ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    106             ENDDO 
    107          ENDDO 
    108  
     104               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;  jm = jm + 1 
     105            END DO 
     106         END DO 
     107         ! 
    109108         DO jk = k1, k2 
    110             WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999. 
    111          ENDDO 
    112                    
     109            WHERE( tmask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid  
     110         END DO 
     111         ! 
    113112      ELSE 
     113         ! 
    114114         jm = 1 
    115115         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 
     116            ! 
     117            DO jj = j1, j2 
     118               DO ji = i1, i2 
     119                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN 
     120                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1) 
     121                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 
     122                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 
     123                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 
     124                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 
     125                  ENDIF 
     126               END DO 
     127            END DO 
     128            jm = jm + 5 
     129            ! 
    121130            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 
    123             ENDDO 
     131               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 
     132                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     133               ENDWHERE 
     134               jm = jm + 1 
     135            END DO 
     136            ! 
    124137            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 
    128  
     138               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 
     139                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     140               ENDWHERE 
     141               jm = jm + 1 
     142            END DO 
     143            ! 
     144         END DO 
     145         ! 
    129146         ! integrated values 
    130          vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 
    131          vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 ) 
    132          at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 ) 
     147         vt_i (i1:i2,j1:j2) = SUM(      v_i(i1:i2,j1:j2,:)           , dim=3 ) 
     148         vt_s (i1:i2,j1:j2) = SUM(      v_s(i1:i2,j1:j2,:)           , dim=3 ) 
     149         at_i (i1:i2,j1:j2) = SUM(      a_i(i1:i2,j1:j2,:)           , dim=3 ) 
    133150         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    134151         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
     
    144161      !! ** Method  : Update the fluxes and recover the properties (C-grid) 
    145162      !!----------------------------------------------------------------------- 
    146       INTEGER , INTENT(in) :: i1, i2, j1, j2 
    147       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
    148       LOGICAL , INTENT(in) :: before 
    149       !! 
    150       REAL(wp) :: zrhoy 
     163      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     164      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     165      LOGICAL                         , INTENT(in   ) ::  before 
     166      !! 
     167      REAL(wp) ::   zrhoy   ! local scalar 
    151168      !!----------------------------------------------------------------------- 
    152169      ! 
     
    154171         zrhoy = Agrif_Rhoy() 
    155172         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 
    156          WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     173         WHERE( umask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid 
    157174      ELSE 
    158          u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 
     175         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 
     176            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 
     177         ENDWHERE 
    159178      ENDIF 
    160179      !  
     
    167186      !! ** Method  : Update the fluxes and recover the properties (C-grid) 
    168187      !!----------------------------------------------------------------------- 
    169       INTEGER , INTENT(in) :: i1,i2,j1,j2 
    170       REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: ptab 
    171       LOGICAL , INTENT(in) :: before 
    172       !! 
    173       REAL(wp) :: zrhox 
     188      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     189      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::  ptab 
     190      LOGICAL                         , INTENT(in   ) ::  before 
     191      !! 
     192      REAL(wp) ::   zrhox   ! local scalar 
    174193      !!----------------------------------------------------------------------- 
    175194      ! 
     
    177196         zrhox = Agrif_Rhox() 
    178197         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 
    179          WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     198         WHERE( vmask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid 
    180199      ELSE 
    181          v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 
     200         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 
     201            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 
     202         ENDWHERE 
    182203      ENDIF 
    183204      ! 
     
    185206 
    186207#else 
     208   !!---------------------------------------------------------------------- 
     209   !!   Empty module                                             no sea-ice 
     210   !!---------------------------------------------------------------------- 
    187211CONTAINS 
    188212   SUBROUTINE agrif_lim3_update_empty 
    189       !!--------------------------------------------- 
    190       !!   *** ROUTINE agrif_lim3_update_empty *** 
    191       !!--------------------------------------------- 
    192213      WRITE(*,*)  'agrif_lim3_update : You should not have seen this print! error?' 
    193214   END SUBROUTINE agrif_lim3_update_empty 
    194215#endif 
     216 
     217   !!====================================================================== 
    195218END MODULE agrif_lim3_update 
Note: See TracChangeset for help on using the changeset viewer.