- Timestamp:
- 2017-09-27T16:29:24+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
r7646 r8568 13 13 !! iscpl_div : correction of divergence to keep volume conservation 14 14 !!---------------------------------------------------------------------- 15 USE oce ! global tra/dyn variable 15 16 USE dom_oce ! ocean space and time domain 16 17 USE domwri ! ocean space and time domain 18 USE domngb ! 17 19 USE phycst ! physical constants 18 20 USE sbc_oce ! surface boundary condition variables 19 USE oce ! global tra/dyn variable 21 USE iscplini ! 22 ! 20 23 USE in_out_manager ! I/O manager 21 24 USE lib_mpp ! MPP library 22 25 USE lib_fortran ! MPP library 23 USE wrk_nemo ! Memory allocation24 26 USE lbclnk ! 25 USE domngb !26 USE iscplini27 27 28 28 IMPLICIT NONE … … 56 56 REAL(wp), DIMENSION(:,:,: ), INTENT(out) :: pvol_flx !! corrective flux to have volume conservation 57 57 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 72 67 INTEGER :: jpts, npts 73 74 CALL wrk_alloc(jpi,jpj, zdssh ) 68 !!---------------------------------------------------------------------- 75 69 76 70 ! get imbalance (volume heat and salt) 77 71 ! initialisation difference 78 zde3t = 0. 0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp72 zde3t = 0._wp ; zdsal = 0._wp ; zdtem = 0._wp 79 73 80 74 ! initialisation correction term 81 pvol_flx(:,:,: ) = 0. 0_wp82 pts_flx (:,:,:,:) = 0. 0_wp75 pvol_flx(:,:,: ) = 0._wp 76 pts_flx (:,:,:,:) = 0._wp 83 77 84 r1_rdtiscpl = 1._wp / prdt_iscpl78 z1_rdtiscpl = 1._wp / prdt_iscpl 85 79 86 80 ! 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 (:,:,:) 89 85 90 86 !============================================================================== … … 118 114 119 115 ! volume, heat and salt differences in each cell 120 pvol_flx(ji,jj,jk) = pvol_flx(ji,jj,jk) + zde3t * r1_rdtiscpl121 pts_flx (ji,jj,jk,jp_sal)= pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl122 pts_flx (ji,jj,jk,jp_tem)= pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl116 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 123 119 124 120 ! case where we close a cell: check if the neighbour cells are wet … … 190 186 ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 191 187 ! allocation and initialisation of the list of problematic point 192 ALLOCATE( inpts(jpnij))193 inpts(:) =0188 ALLOCATE( inpts(jpnij) ) 189 inpts(:) = 0 194 190 195 191 ! fill narea location with the number of problematic point … … 287 283 CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 288 284 CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 289 290 ! deallocate variables 291 CALL wrk_dealloc(jpi,jpj, zdssh ) 292 285 ! 293 286 END SUBROUTINE iscpl_cons 287 294 288 295 289 SUBROUTINE iscpl_div( phdivn )
Note: See TracChangeset
for help on using the changeset viewer.