- Timestamp:
- 2020-07-03T19:15:31+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/CRS/crsdom.F90
r12807 r13247 86 86 zmask = 0.0 87 87 zmask = SUM( tmask(ijis:ijie,ij:je_2,jk) ) 88 IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 88 IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0_wp 89 89 90 90 zmask = 0.0 91 91 zmask = SUM( vmask(ijis:ijie,je_2 ,jk) ) 92 IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 92 IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0_wp 93 93 94 94 zmask = 0.0 95 95 zmask = SUM(umask(ijie,ij:je_2,jk)) 96 IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 96 IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0_wp 97 97 98 98 fmask_crs(ji,je_2,jk) = fmask(ijie,2,jk) … … 108 108 zmask = 0.0 109 109 zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 110 IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0 110 IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0_wp 111 111 112 112 zmask = 0.0 113 113 zmask = SUM( vmask(ijis:ijie,ijje ,jk) ) 114 IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0 114 IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0_wp 115 115 116 116 zmask = 0.0 117 117 zmask = SUM( umask(ijie ,ijjs:ijje,jk) ) 118 IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0 118 IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0_wp 119 119 120 120 fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk) … … 124 124 125 125 ! 126 CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )127 CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 )128 CALL crs_lbc_lnk( umask_crs, 'U', 1.0 )129 CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 )126 CALL crs_lbc_lnk( tmask_crs, 'T', 1.0_wp ) 127 CALL crs_lbc_lnk( vmask_crs, 'V', 1.0_wp ) 128 CALL crs_lbc_lnk( umask_crs, 'U', 1.0_wp ) 129 CALL crs_lbc_lnk( fmask_crs, 'F', 1.0_wp ) 130 130 ! 131 131 END SUBROUTINE crs_dom_msk … … 206 206 207 207 ! Retroactively add back the boundary halo cells. 208 CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0 )209 CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 )208 CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0_wp ) 209 CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0_wp ) 210 210 211 211 ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd … … 296 296 ENDDO 297 297 298 CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0 , pfillval=1.0)299 CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0 , pfillval=1.0)298 CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0_wp, pfillval=1.0_wp ) 299 CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0_wp, pfillval=1.0_wp ) 300 300 301 301 END SUBROUTINE crs_dom_hgr … … 440 440 ENDDO 441 441 ! ! Retroactively add back the boundary halo cells. 442 CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0 )443 CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 )442 CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0_wp ) 443 CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0_wp ) 444 444 ! 445 445 ! … … 1748 1748 ENDDO 1749 1749 1750 CALL crs_lbc_lnk( p_e3_crs , cd_type, 1.0 , pfillval=1.0)1751 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0 , pfillval=1.0)1750 CALL crs_lbc_lnk( p_e3_crs , cd_type, 1.0_wp, pfillval=1.0_wp ) 1751 CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0_wp, pfillval=1.0_wp ) 1752 1752 ! 1753 1753 ! … … 1857 1857 ENDDO 1858 1858 1859 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0 , pfillval=1.0)1860 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0 , pfillval=1.0)1859 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0_wp, pfillval=1.0_wp ) 1860 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0_wp, pfillval=1.0_wp ) 1861 1861 1862 1862 END SUBROUTINE crs_dom_sfc … … 2242 2242 2243 2243 zmbk(:,:) = 0.0 2244 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0 ) ; mbathy_crs(:,:) = NINT( zmbk(:,:) )2244 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0_wp) ; mbathy_crs(:,:) = NINT( zmbk(:,:) ) 2245 2245 2246 2246 … … 2262 2262 ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 2263 2263 zmbk(:,:) = 1.e0; 2264 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0 ) ; mbku_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 )2265 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0 ) ; mbkv_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 )2264 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0_wp) ; mbku_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2265 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0_wp) ; mbkv_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2266 2266 ! 2267 2267 END SUBROUTINE crs_dom_bat
Note: See TracChangeset
for help on using the changeset viewer.