Changeset 13226 for NEMO/trunk/src/OCE/CRS
- Timestamp:
- 2020-07-02T16:24:31+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/CRS
- Files:
-
- 4 edited
-
crsdom.F90 (modified) (10 diffs)
-
crsdomwri.F90 (modified) (2 diffs)
-
crsfld.F90 (modified) (11 diffs)
-
crsini.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/CRS/crsdom.F90
r11536 r13226 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 … … 2246 2246 2247 2247 zmbk(:,:) = 0.0 2248 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0 ) ; mbathy_crs(:,:) = NINT( zmbk(:,:) )2248 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0_wp) ; mbathy_crs(:,:) = NINT( zmbk(:,:) ) 2249 2249 2250 2250 … … 2266 2266 ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 2267 2267 zmbk(:,:) = 1.e0; 2268 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0 ) ; mbku_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 )2269 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0 ) ; mbkv_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 )2268 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0_wp) ; mbku_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2269 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0_wp) ; mbkv_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2270 2270 ! 2271 2271 END SUBROUTINE crs_dom_bat -
NEMO/trunk/src/OCE/CRS/crsdomwri.F90
r12377 r13226 161 161 END DO 162 162 END DO 163 CALL crs_lbc_lnk( zdepu,'U', 1. ) ; CALL crs_lbc_lnk( zdepv,'V', 1.)163 CALL crs_lbc_lnk( zdepu,'U', 1.0_wp ) ; CALL crs_lbc_lnk( zdepv,'V', 1.0_wp ) 164 164 ! 165 165 CALL iom_rstput( 0, 0, inum, 'gdepu', zdepu, ktype = jp_r4 ) … … 222 222 ! 223 223 puniq(:,:) = ztstref(:,:) ! default definition 224 CALL crs_lbc_lnk( puniq,cdgrd, 1. ) ! apply boundary conditions224 CALL crs_lbc_lnk( puniq,cdgrd, 1.0_wp ) ! apply boundary conditions 225 225 lldbl(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have been changed 226 226 ! -
NEMO/trunk/src/OCE/CRS/crsfld.F90
r12377 r13226 98 98 ! Temperature 99 99 zt(:,:,:) = ts(:,:,:,jp_tem,Kmm) ; zt_crs(:,:,:) = 0._wp 100 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )100 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 101 101 tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 102 102 … … 107 107 ! Salinity 108 108 zs(:,:,:) = ts(:,:,:,jp_sal,Kmm) ; zs_crs(:,:,:) = 0._wp 109 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )109 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 110 110 tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 111 111 … … 114 114 115 115 ! U-velocity 116 CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )116 CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 117 117 ! 118 118 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 121 121 zs(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 122 122 END_3D 123 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )124 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )123 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 124 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp ) 125 125 126 126 CALL iom_put( "uoce" , un_crs ) ! i-current … … 129 129 130 130 ! V-velocity 131 CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )131 CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 132 132 ! 133 133 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp … … 136 136 zs(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 137 137 END_3D 138 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )139 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )138 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 139 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp ) 140 140 141 141 CALL iom_put( "voce" , vn_crs ) ! i-current … … 153 153 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 154 154 END_3D 155 CALL lbc_lnk( 'crsfld', z3d, 'T', 1. )155 CALL lbc_lnk( 'crsfld', z3d, 'T', 1.0_wp ) 156 156 ! 157 CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 )157 CALL crs_dom_ope( z3d, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0_wp ) 158 158 CALL iom_put( "eken", zt_crs ) 159 159 ENDIF … … 173 173 END DO 174 174 END DO 175 CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 )175 CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0_wp ) 176 176 ! 177 177 CALL iom_put( "hdiv", hdivn_crs ) … … 180 180 ! W-velocity 181 181 IF( ln_crs_wn ) THEN 182 CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )182 CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0_wp ) 183 183 ! CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 184 184 ELSE … … 194 194 SELECT CASE ( nn_crs_kz ) 195 195 CASE ( 0 ) 196 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )197 CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )196 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 197 CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 198 198 CASE ( 1 ) 199 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )200 CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )199 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 200 CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 201 201 CASE ( 2 ) 202 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )203 CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 )202 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 203 CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0_wp ) 204 204 END SELECT 205 205 ! … … 208 208 209 209 ! sbc fields 210 CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0 )211 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 )212 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 )213 CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )214 CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0 )215 CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )216 CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )217 CALL crs_dom_ope( emp , 'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )218 CALL crs_dom_ope( sfx , 'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )219 CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 )210 CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp ) 211 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0_wp ) 212 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0_wp ) 213 CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 214 CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0_wp ) 215 CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 216 CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 217 CALL crs_dom_ope( emp , 'SUM', 'T', tmask, emp_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 218 CALL crs_dom_ope( sfx , 'SUM', 'T', tmask, sfx_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 219 CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) 220 220 221 221 CALL iom_put( "ssh" , sshn_crs ) ! ssh output -
NEMO/trunk/src/OCE/CRS/crsini.F90
r12377 r13226 207 207 208 208 ! 3.d.3 Vertical depth (meters) 209 CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0 )210 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0 )209 CALL crs_dom_ope( gdept_0, 'MAX', 'T', tmask, gdept_crs, p_e3=ze3t, psgn=1.0_wp ) 210 CALL crs_dom_ope( gdepw_0, 'MAX', 'W', tmask, gdepw_crs, p_e3=ze3w, psgn=1.0_wp ) 211 211 212 212
Note: See TracChangeset
for help on using the changeset viewer.
