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 8568 for branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90 – NEMO

Ignore:
Timestamp:
2017-09-27T16:29:24+02:00 (7 years ago)
Author:
gm
Message:

#1911 (ENHANCE-09): PART I.2 - _NONE option + remove zts + see associated wiki page

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

    r7646 r8568  
    1313   !!   iscpl_div      : correction of divergence to keep volume conservation 
    1414   !!---------------------------------------------------------------------- 
     15   USE oce             ! global tra/dyn variable 
    1516   USE dom_oce         ! ocean space and time domain 
    1617   USE domwri          ! ocean space and time domain 
     18   USE domngb          !  
    1719   USE phycst          ! physical constants 
    1820   USE sbc_oce         ! surface boundary condition variables 
    19    USE oce             ! global tra/dyn variable 
     21   USE iscplini        !  
     22   ! 
    2023   USE in_out_manager  ! I/O manager 
    2124   USE lib_mpp         ! MPP library 
    2225   USE lib_fortran     ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2426   USE lbclnk          ! 
    25    USE domngb          ! 
    26    USE iscplini 
    2727 
    2828   IMPLICIT NONE 
     
    5656      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation 
    5757      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period  
    58       !! 
    59       INTEGER :: ji, jj, jk                                    !! loop index 
    60       INTEGER :: jip1, jim1, jjp1, jjm1 
    61       !! 
    62       REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb 
    63       REAL(wp):: r1_rdtiscpl 
    64       REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio 
    65       !! 
    66       REAL(wp):: zde3t, zdtem, zdsal 
    67       REAL(wp), DIMENSION(:,:), POINTER :: zdssh 
    68       !! 
    69       REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat 
    70       REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal 
    71       INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts 
     58      ! 
     59      INTEGER  ::   ji  , jj  , jk           ! loop index 
     60      INTEGER  ::   jip1, jim1, jjp1, jjm1 
     61      REAL(wp) ::   summsk, zsum , zsumn, zjip1_ratio  , zjim1_ratio, zdtem, zde3t, z1_rdtiscpl 
     62      REAL(wp) ::   zarea , zsum1, zsumb, zjjp1_ratio  , zjjm1_ratio, zdsal 
     63      REAL(wp), DIMENSION(jpi,jpj)        ::   zdssh   ! workspace 
     64      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zlon, zlat 
     65      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zcorr_vol, zcorr_tem, zcorr_sal 
     66      INTEGER , DIMENSION(:), ALLOCATABLE ::   ixpts, iypts, izpts, inpts 
    7267      INTEGER :: jpts, npts 
    73  
    74       CALL wrk_alloc(jpi,jpj, zdssh ) 
     68      !!---------------------------------------------------------------------- 
    7569 
    7670      ! get imbalance (volume heat and salt) 
    7771      ! initialisation difference 
    78       zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp 
     72      zde3t = 0._wp   ;   zdsal = 0._wp   ;   zdtem = 0._wp 
    7973 
    8074      ! initialisation correction term 
    81       pvol_flx(:,:,:  ) = 0.0_wp 
    82       pts_flx (:,:,:,:) = 0.0_wp 
     75      pvol_flx(:,:,:  ) = 0._wp 
     76      pts_flx (:,:,:,:) = 0._wp 
    8377       
    84       r1_rdtiscpl = 1._wp / prdt_iscpl  
     78      z1_rdtiscpl = 1._wp / prdt_iscpl  
    8579 
    8680      ! mask tsn and tsb  
    87       tsb(:,:,:,jp_tem)=tsb(:,:,:,jp_tem)*ptmask_b(:,:,:); tsn(:,:,:,jp_tem)=tsn(:,:,:,jp_tem)*tmask(:,:,:); 
    88       tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:); 
     81      tsb(:,:,:,jp_tem) = tsb(:,:,:,jp_tem) * ptmask_b(:,:,:) 
     82      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) *  tmask  (:,:,:) 
     83      tsb(:,:,:,jp_sal) = tsb(:,:,:,jp_sal) * ptmask_b(:,:,:) 
     84      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) *  tmask  (:,:,:) 
    8985 
    9086      !============================================================================== 
     
    118114 
    119115                  ! volume, heat and salt differences in each cell  
    120                   pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl 
    121                   pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl  
    122                   pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl 
     116                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * z1_rdtiscpl 
     117                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * z1_rdtiscpl  
     118                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * z1_rdtiscpl 
    123119 
    124120                  ! case where we close a cell: check if the neighbour cells are wet  
     
    190186      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point  
    191187      ! allocation and initialisation of the list of problematic point 
    192       ALLOCATE(inpts(jpnij)) 
    193       inpts(:)=0 
     188      ALLOCATE( inpts(jpnij) ) 
     189      inpts(:) = 0 
    194190 
    195191      ! fill narea location with the number of problematic point 
     
    287283      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 
    288284      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 
    289  
    290       ! deallocate variables 
    291       CALL wrk_dealloc(jpi,jpj, zdssh )  
    292  
     285      ! 
    293286   END SUBROUTINE iscpl_cons 
     287 
    294288 
    295289   SUBROUTINE iscpl_div( phdivn ) 
Note: See TracChangeset for help on using the changeset viewer.