Changeset 1565 for trunk/NEMO/OPA_SRC/DYN/sshwzv.F90
- Timestamp:
- 2009-07-31T16:01:08+02:00 (15 years ago)
- File:
-
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DYN/sshwzv.F90
r1564 r1565 1 MODULE wzvmod 2 !! MODULE sshwzv 1 MODULE sshwzv 3 2 !!============================================================================== 4 3 !! *** MODULE sshwzv *** … … 17 16 USE sbc_oce ! surface boundary condition: ocean 18 17 USE domvvl ! Variable volume 18 USE divcur ! hor. divergence and curl (div & cur routines) 19 USE cla_div ! cross land: hor. divergence (div_cla routine) 19 20 USE iom ! I/O library 20 21 USE restart ! only for lrst_oce … … 109 110 ENDIF 110 111 111 ! set time step size (Euler/Leapfrog)112 z2dt = 2. * rdt113 IF( neuler == 0 .AND. kt == nit000 ) z2dt =rdt114 115 zraur = 1. / rauw116 117 ! !------------------------------!118 ! ! After Sea Surface Height !119 ! !------------------------------!120 zhdiv(:,:) = 0.e0121 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports122 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)123 END DO124 125 ! ! Sea surface elevation time stepping126 ssha(:,:) = ( sshb(:,:) - z2dt * ( zraur * emp(:,:) + zhdiv(:,:) ) ) * tmask(:,:,1)127 128 #if defined key_obc129 # if defined key_agrif130 IF ( Agrif_Root() ) THEN131 # endif132 ssha(:,:) = ssha(:,:) * obctmsk(:,:)133 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm)134 # if defined key_agrif135 ENDIF136 # endif137 #endif138 139 ! ! Sea Surface Height at u-,v- and f-points (vvl case only)140 IF( lk_vvl ) THEN ! (required only in key_vvl case)141 DO jj = 1, jpjm1142 DO ji = 1, fs_jpim1 ! Vector Opt.143 sshu_a(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) &144 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj) &145 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) )146 sshv_a(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) ) &147 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj ) &148 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )149 sshf_a(ji,jj) = 0.25 * umask(ji,jj,1) * umask (ji,jj+1,1) & ! Caution : fmask not used150 & * ( ssha(ji ,jj) + ssha(ji ,jj+1) &151 & + ssha(ji+1,jj) + ssha(ji+1,jj+1) )152 END DO153 END DO154 CALL lbc_lnk( sshu_a, 'U', 1. ) ! Boundaries conditions155 CALL lbc_lnk( sshv_a, 'V', 1. )156 CALL lbc_lnk( sshf_a, 'F', 1. )157 ENDIF158 159 ! !------------------------------!160 ! ! Now Vertical Velocity !161 ! !------------------------------!162 ! ! integrate from the bottom the hor. divergence163 DO jk = jpkm1, 1, -1164 wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) &165 & - ( fse3t_a(:,:,jk) &166 & - fse3t_b(:,:,jk) ) * tmask(:,:,jk) / z2dt167 END DO168 !169 CALL iom_put( "woce", wn ) ! vert. current170 CALL iom_put( "ssh" , sshn ) ! sea surface height171 172 112 ! !------------------------------! 173 113 ! ! Update Now Vertical coord. ! … … 194 134 hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1.e0 - umask(:,:,1) ) 195 135 hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) 196 197 ENDIF 136 ! 137 ENDIF 138 139 CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity 140 IF( n_cla == 1 ) CALL div_cla( kt ) ! Cross Land Advection (Update Hor. divergence) 141 142 ! set time step size (Euler/Leapfrog) 143 z2dt = 2. * rdt 144 IF( neuler == 0 .AND. kt == nit000 ) z2dt =rdt 145 146 zraur = 1. / rauw 147 148 ! !------------------------------! 149 ! ! After Sea Surface Height ! 150 ! !------------------------------! 151 zhdiv(:,:) = 0.e0 152 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 153 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 154 END DO 155 156 ! ! Sea surface elevation time stepping 157 ssha(:,:) = ( sshb(:,:) - z2dt * ( zraur * emp(:,:) + zhdiv(:,:) ) ) * tmask(:,:,1) 158 159 #if defined key_obc 160 # if defined key_agrif 161 IF ( Agrif_Root() ) THEN 162 # endif 163 ssha(:,:) = ssha(:,:) * obctmsk(:,:) 164 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 165 # if defined key_agrif 166 ENDIF 167 # endif 168 #endif 169 170 ! ! Sea Surface Height at u-,v- and f-points (vvl case only) 171 IF( lk_vvl ) THEN ! (required only in key_vvl case) 172 DO jj = 1, jpjm1 173 DO ji = 1, fs_jpim1 ! Vector Opt. 174 sshu_a(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & 175 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj) & 176 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) ) 177 sshv_a(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) ) & 178 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj ) & 179 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) ) 180 sshf_a(ji,jj) = 0.25 * umask(ji,jj,1) * umask (ji,jj+1,1) & ! Caution : fmask not used 181 & * ( ssha(ji ,jj) + ssha(ji ,jj+1) & 182 & + ssha(ji+1,jj) + ssha(ji+1,jj+1) ) 183 END DO 184 END DO 185 CALL lbc_lnk( sshu_a, 'U', 1. ) ! Boundaries conditions 186 CALL lbc_lnk( sshv_a, 'V', 1. ) 187 CALL lbc_lnk( sshf_a, 'F', 1. ) 188 ENDIF 189 190 ! !------------------------------! 191 ! ! Now Vertical Velocity ! 192 ! !------------------------------! 193 ! ! integrate from the bottom the hor. divergence 194 DO jk = jpkm1, 1, -1 195 wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) & 196 & - ( fse3t_a(:,:,jk) & 197 & - fse3t_b(:,:,jk) ) * tmask(:,:,jk) / z2dt 198 END DO 199 ! 200 CALL iom_put( "woce", wn ) ! vert. current 201 CALL iom_put( "ssh" , sshn ) ! sea surface height 198 202 ! 199 203 END SUBROUTINE ssh_wzv … … 307 311 308 312 !!====================================================================== 309 END MODULE wzvmod313 END MODULE sshwzv
Note: See TracChangeset
for help on using the changeset viewer.